VBA 从 Excel 更新 Word 中的书签 - 仅运行一次？

Question

我在 Excel 中有以下代码，该代码旨在使用输入到电子表格中的信息来填充各种 Word 文档中的书签。 就上下文而言，我需要使用 90% 的相同信息生成多个文档，并将所有相关信息保存在 Excel 工作表中使这更容易。

我的电子表格允许我使用输入到工作表中的信息生成最多五个文档。 我在填写表格时设置了需要生成多少文件。 可以生成文档的 5 种变体，代码旨在检查需要什么类型，打开为该类型设计的文件并填充数据。

我遇到的问题是，当我第一次打开 Excel 并运行宏时，它可以正常工作 - 它会打开相关的 Word 文档，用数据填充它们，更新字段并保存更新的文档。

但是，如果我再次尝试运行宏，它不会填充文档中的书签。 文档仍然会被保存，但它与基本模板没有什么不同。

如果我关闭 Excel，重新打开它并运行宏，它可以正常运行一次。

我已经尝试了一些调试，问题似乎出在这部分代码上：

On Error Resume Next
   Set wd = GetObject(, "Word.Application")
   If Err <> 0 Then
       Set wd = CreateObject("Word.Application")
   End If

在我的调试中，我添加了一个消息框来查看 if Err <> 0 是否正确。 宏第一次在打开单词时运行，它到达以下行：

Set wd = CreateObject("Word.Application")

在随后的运行中，只返回：

Set wd = GetObject(, "Word.Application")

我尝试将两者都设置为 Set wd = CreateObject("Word.Application") 但这不起作用。

想法？ 我的代码如下。

在此先感谢您的帮助。

Sub GteeDisc()
 'Dim OutApp As Outlook.Application
 'Dim OutMail As Outlook.MailItem
 Dim wb As Workbook
 Dim wt As Worksheet
 Dim wd As New Word.Application
 Dim mail_doc As Word.Document
 'Dim email_text As Word.Document
 Dim objInspector As Object
 Dim objDoc As Object
 
 Dim Borrower_Name As String
 Dim Bank_Name As String
 
 Dim Gtor_Name As String
 Dim Gtee_Limit As String
 Dim Max_term As String
 Dim max_term_unit As String
 Dim GteeLimit As String
 Dim Total_borrowing As String
 Dim Loan_type As String
 Dim total_loans As String
 Dim Gtor_entity As String
 Dim Total_Guarantees As Integer
 
 
 
 
 
 
    'Set wb = ActiveWorkbook
    'Worksheets("Lending Details").Activate
    'Set wt = ActiveSheet
    
    Set wt = ThisWorkbook.Worksheets("Lending Details")
    
    Borrower_Name = wt.Range("B2").Text
    Bank_Name = wt.Range("E3").Text
    
    
    Max_term = wt.Range("L7").Value
    max_term_unit = wt.Range("L8").Value
    'Total_borrowing = wt.Range("L6").Value
    
   
    
    If wt.Range("L9").Value = "Revolving Credit Facility" Then
    Loan_type = "RCF"
    Else
    Loan_type = "Non-RCF"
    End If
   
  Total_Guarantees = wt.Range("B121").Value
  If Total_Guarantees > 0 Then
   For i = 1 To Total_Guarantees
   
   If i = 1 Then
    Gtor_entity = wt.Range("B123").Value
    Gtor_Name = wt.Range("B124").Value
    Gtee_Type = wt.Range("B125").Value
    Gtee_Limit = wt.Range("B126").Value
   ElseIf i = 2 Then
    Gtor_entity = wt.Range("B129").Value
    Gtor_Name = wt.Range("B130").Value
    Gtee_Type = wt.Range("B131").Value
    Gtee_Limit = wt.Range("B132").Value
   ElseIf i = 3 Then
    Gtor_entity = wt.Range("B135").Value
    Gtor_Name = wt.Range("B136").Value
    Gtee_Type = wt.Range("B137").Value
    Gtee_Limit = wt.Range("B138").Value
   ElseIf i = 4 Then
    Gtor_entity = wt.Range("B141").Value
    Gtor_Name = wt.Range("B142").Value
    Gtee_Type = wt.Range("B143").Value
    Gtee_Limit = wt.Range("B144").Value
   ElseIf i = 5 Then
    Gtor_entity = wt.Range("B147").Value
    Gtor_Name = wt.Range("B149").Value
    Gtee_Type = wt.Range("B150").Value
    Gtee_Limit = wt.Range("B151").Value
   End If
    'is Gtee Limited or unlimited
    If Gtee_Type = "Limited" Then
    Gtee_Type = "Limited"
    Else
    Gtee_Type = "Unlimited"
    End If
    
     
    
    On Error Resume Next
    Set wd = GetObject(, "Word.Application")
    If Err <> 0 Then
       Set wd = CreateObject("Word.Application")
    End If
    
    
    
    If Gtor_entity = "Individual" Then
    Set mail_doc = wd.Documents.Open("C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\04 - Gurantees\GDL & Waiver - Individual.docx")
    
    ElseIf Gtor_entity = "Couple" Then
    Set mail_doc = wd.Documents.Open("C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\04 - Gurantees\GDL & Waiver - Couple.docx")
    
    ElseIf Gtor_entity = "Company" Then
    Set mail_doc = wd.Documents.Open("C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\04 - Gurantees\GDL & Waiver - Company.docx")
    
    ElseIf Gtor_entity = "Partnership" Then
    Set mail_doc = wd.Documents.Open("C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\04 - Gurantees\GDL & Waiver - Company.docx")
    
    ElseIf Gtor_entity = "Trust" Then
    Set mail_doc = wd.Documents.Open("C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\04 - Gurantees\GDL & Waiver - Trust.docx")
    
    End If
    Application.Wait (Now + TimeValue("0:00:02"))
    
    
    
    With mail_doc
    
    UpdateBookmarkContent "bmBankName", Bank_Name
    UpdateBookmarkContent "bmBorrowerName", Borrower_Name
    UpdateBookmarkContent "bmGtorName", Gtor_Name
    UpdateBookmarkContent "bmGtorName1", Gtor_Name
    
    UpdateBookmarkContent "bmtotalBorrowing", Format(CDbl(wt.Range("L6").Value), "#,##0.00")
        
    UpdateBookmarkContent "bmMaxTerm", Max_term
    UpdateBookmarkContent "bmMaxTermunit", max_term_unit
    
    If Gtee_Type = "Limited" Then
    'UpdateBookmarkContent "bmGteeLimit", Gtee_Limit
    UpdateBookmarkContent "bmGteeLimit", Format(CDbl(Gtee_Limit), "#,##0.00")
    UpdateBookmarkContent "bmGuaranteeLimit", "Limited Guarantee"
    UpdateBookmarkContent "bmGuaranteeLimit2", "Guarantee Limited to $" & Format(CDbl(Gtee_Limit), "#,##0.00")
    UpdateBookmarkContent "bmGuaranteeLimit3", "a guarantee limited to $" & Format(CDbl(Gtee_Limit), "#,##0.00")
    
    mail_doc.Bookmarks("bmUnlimitedGtee").Range.Font.Hidden = True
    
    Else
    UpdateBookmarkContent "bmGuaranteeLimit", "Unlimited Guarantee"
    UpdateBookmarkContent "bmGuaranteeLimit3", "an unlimited guarantee"
    End If
    
    
   
    
           
    mail_doc.Fields.Update
    
    
    
    mail_doc.SaveAs Filename:="C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\07 - Generated Docs\GDL & Waiver - " & Gtor_Name & ".docx"
    'mail_doc.ExportAsFixedFormat OutputFileName:="C:\Users\tsiso\Dropbox\HLS Convey\Documents\01 - Refinance\07 - Generated Docs\DM Request Letter - " & Bank_Name & " (" & Client_Name & ").pdf", ExportFormat:=wdExportFormatPDF
    End With
    
    mail_doc.Close
    
  Next i
End If
Application.ScreenUpdating = True
'mail_doc.Close
'wd.Quit
Set mail_doc = Nothing
Set wd = Nothing
'MsgBox "Done!"
End Sub

[更新]

因此，我对此进行了更多测试，但仍然无法使其正常工作。 主要问题似乎与这部分代码有关：

On Error Resume Next
Set wd = GetObject(, "Word.Application")
If Err <> 0 Then
   Set wd = CreateObject("Word.Application")
End If

从我从测试中可以看出，当代码运行该行时

set wd = GetObject(, "Word.Application")

宏工作并更新word doc。 当宏运行这些行时

If Err <> 0 Then
           Set wd = CreateObject("Word.Application")

宏不起作用

就这段代码中使用的函数而言，如下所示：

Function UpdateBookmarkContent(strBookMarkName As String, strNewText As String) As String
    Dim oRangeBKM As Word.Range
    If ActiveDocument.Bookmarks.Exists(strBookMarkName) Then
        Set oRangeBKM = ActiveDocument.Bookmarks(strBookMarkName).Range
        oRangeBKM.Text = strNewText
        ActiveDocument.Bookmarks.Add strBookMarkName, oRangeBKM
    End If
End Function

总结 我想要实现的是打开一个 word 文档，用 Excel 工作表中的数据更新该 word 文档中的书签。 更新了其中几个书签并保留了书签，以便可以更新 Word 文档中引用它们的字段。

任何有关我的代码出错的地方的帮助将不胜感激。 谢谢

Answer 1

我看不出您需要任何 GetObject 或 CreateObject 代码。 您已经使用Dim wd As New Word.Application ... 创建了一个新的 Word 应用程序对象，并且New实例化了该对象。 然后您需要做的就是打开文档……处理它……然后再次关闭它。 例如一个简单的例子......

Option Explicit

Sub Example()
    
    Dim wd As New Word.Application
    Dim mail_doc As Word.Document
    
    Set mail_doc = wd.Documents.Open("C:\test1.docx")
    mail_doc.SaveAs Filename:="C:\test2.docx"
    mail_doc.Close
    wd.Quit
    
End Sub

（另外，考虑到 for 循环，我假设Gtor_Name在迭代之间保持唯一......以便.SaveAs不会覆盖同一个文档）。