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

【问题标题】：VBA updating bookmarks in Word from Excel - Only Runs Once?VBA 从 Excel 更新 Word 中的书签 - 只运行一次？
【发布时间】：2020-12-22 03:56:48
【问题描述】：

我在 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")

宏工作并更新单词 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 doc，该word doc中的书签用Excel工作表中的数据更新。其中一些书签已更新并保留了书签，以便 Word 文档中引用它们的字段可以更新。

如果我在我的代码中出错的地方提供任何帮助，我们将不胜感激。谢谢

【问题讨论】：

UpdateBookmarkContent 可能是其中的重要组成部分？
好的，这有帮助。 [UpdateBookmarkContent] 是我在工作表中拥有的功能，并且（奇怪地）在 ThisWorkbook 中拥有它自己的功能。通过将其更改为公共功能，这已经解决了问题。谢谢@TimWilliams，这有帮助（尽管我怀疑这是一个创可贴解决方案）

标签： excel vba

【解决方案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 不会覆盖同一个文档）。

【讨论】：

感谢您的帮助@TechnoDabbler 将 UpdateBookmarkContent 函数设为公共函数似乎可以解决此问题。当我使用上述内容时，我收到以下错误错误 -2147417848 (&H80010108)：调用的对象已与其客户端断开连接