Updating Bookmarks in word with vba

Question

The following program attempts to generate a report from a word template. It will generate a new report or open an existing one if it already exists. I would like my users to be able to update the bookmarks in this report but they are being copied over. I found another thread on this site that discussed how to duplicate and replace the bookmarks and inserted it in my code below. The code is running without any errors but the bookmarks don't seem to be updating. When I run the code the second time on the added document the code breaks and I get run-time error '462: The remote server machine does not exist or is unavailable and highlights the first line of code that inserts values to the word bookmarks. I am assuming this is because the bookmark no longer exists. I'm a real newbie so maybe its something real simple. I appreciate any and all assistance.

Set wdApp = CreateObject("word.application")

FilePath = Application.ThisWorkbook.Path & "\" & "WriteUp Template " & ActiveSheet.Name & ".docx"

If Dir(FilePath) <> "" Then

With wdApp
.Visible = True
.Activate
.documents.Open Application.ThisWorkbook.Path & "\" & "WriteUp Template " & ActiveSheet.Name & ".docx"
End With
Else
With wdApp
.Visible = True
.Activate
.documents.Add Application.ThisWorkbook.Path & "\" & "WriteUp Template.docx"
End With
End If


 For Each xlName In Excel.ThisWorkbook.Names

'if xlName's name is existing in document then put the value in place of the bookmark
If wdApp.ActiveDocument.Bookmarks.Exists(xlName.Name) Then
    'Copy the Bookmark's Range.
    Set BMRange = wdApp.ActiveDocument.Bookmarks(xlName.Name).Range.Duplicate
    BMRange.Text = Range(xlName.Value)
    'Re-insert the bookmark
    wdApp.ActiveDocument.Bookmarks.Add xlName.Name, BMRange
End If

Next xlName



'Insert title of Company

Set CompanyTitle = Range("B1:B20").Find("Cash Flow", , , , , , False).Offset(0, 1)
wdApp.ActiveDocument.Bookmarks("CompanyTitleCF").Range = CompanyTitle.Value

Answer 1

Untested but should work:

Sub Tester()

    Dim wdApp, FilePath, doc1 As Object, doc2 As Object, fldr As String
    Dim xlName, CompanyTitle As Range

    Set wdApp = CreateObject("word.application")
    wdApp.visisble = True

    fldr = ThisWorkbook.Path & "\"
    FilePath = fldr & "WriteUp Template " & ActiveSheet.Name & ".docx"

    '<tw>Best to assign each doc to a variable as you open it, so you can
    '   refer to it later instead of using "Activedocument"
    If Dir(FilePath) <> "" Then
        Set doc1 = wdApp.documents.Open(FilePath)
        Set doc2 = wdApp.documents.Open(fldr & "WriteUp Template.docx")
    End If

    For Each xlName In ThisWorkbook.Names
        'if xlName's name is existing in document then put the value in place of the bookmark
        ' <tw>Assume you mean to work with doc2 here...
        If doc2.Bookmarks.Exists(xlName.Name) Then
            SetBookmarkText doc2, xlName.Name, Range(xlName.Value) '<< call utility sub
        End If
    Next xlName

    'Insert title of Company
    Set CompanyTitle = Range("B1:B20").Find("Cash Flow", , , , , , False).Offset(0, 1)
    SetBookmarkText doc2, "CompanyTitleCF", CompanyTitle.Value

End Sub


'Replace the text in a bookmark or insert text into an empty (zero-length) bookmark
Sub SetBookmarkText(oDoc As Object, sBookmark As String, sText As String)
    Dim BMRange As Object
    If oDoc.Range.Bookmarks.Exists(sBookmark) Then
      Set BMRange = oDoc.Range.Bookmarks(sBookmark).Range
      BMRange.Text = sText
      oDoc.Range.Bookmarks.Add sBookmark, BMRange
    Else
      MsgBox "Bookmark '" & sBookmark & "' not found in document '" & oDoc.Name & "'" & _
              vbCrLf & "Content not updated"
    End If
End Sub