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

Question

I have the code below in Excel which is designed to use information entered into the spreadsheet to populate bookmarks in various Word documents. For context, I need to produce multiple documents using 90% of the same information and holding all relevant info in an Excel sheet makes this easier.

My spreadsheet allows me to produce up to five documents using the information entered into the worksheet. I set how many documents need to be produced when filling out the form. There are 5 variations of the document that can be produced and the code is designed to check what type is needed, open that file that is designed for that type and populate with the data.

The issue I'm having is that when I open Excel and run the macro the first time it works fine - it opens the relevant Word doc(s), populates them with the data, updates the fields and saves the updated document.

If I try and run the macro again however, it does not populate the bookmarks in the document(s). The document still gets saved but it is no different than the base template.

If I close Excel, reopen it and run the macro, it works fine for one run.

I have tried some of the debugging and the issue appears to be with this part of the code:

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

In my debugging I added a message box to see if the if Err <> 0 is correct. The first time the macro runs on opening word it reaches the line:

Set wd = CreateObject("Word.Application")

On subsequent runs though is only returns:

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

I have tried setting both to Set wd = CreateObject("Word.Application") but that does not work.

Thoughts? my code is below.

Thanks in advance for your help.

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

[Update]

So I have done some more testing on this and still cannot get it to work. The main issue appears to be with this part of the code:

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

From what I can tell from testing, when the code runs the line

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

the macro works and updates the word doc. When the macro runs the lines

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

The macro does not work

In terms of the function that is used within this code, it is as follows:

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

Summary What I am trying to achieve is a word doc is opened, bookmarks within that word doc are updated with data from the Excel sheet. Several of these bookmarks are updated and the bookmark retained so that fields in Word doc that refer to them can be updated.

Any assistance with where I am going wrong in my code would be appreciated. Thanks

Answer 1

I can't see that you need any of the GetObject or CreateObject code. You already create a new Word application object with Dim wd As New Word.Application ... and the New instantiates the object. All you then need to do is open the document .. work on it ... and close it again. Eg a simple example ...

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

(Also, given the for loop, I assume that Gtor_Name remains unique between iterations ... so that the .SaveAs doesn't overwrite the same document).