excelvbadatabasems-word

Replacing placeholders in word file with VBA


I have an Excel file which contains names and adresses of employees working in the company i work for. I was asked if i could optimize the following process. They create a list with selected people from the whole excel file and then need to print it on paper with integrated stickers. They have a word template so the format fits everytime, but typing in all the names and andresses is tedious work. I know how to code in Python but i figured it would be easier to do it in VBA. So i tasked ChatGPT to give me a code which does what i want.

Sub Insert()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim ws As Worksheet
    Dim i As Integer
    Dim fieldNames As Variant
    Dim fieldValues As Variant
    Dim xlpath As String
    Dim wordpath As String


    xlpath = ThisWorkbook.Path & "\Excelvorlage.xlsx"
    
    wordpath = ThisWorkbook.Path & "\Test.docx"
    
    Set ws = ThisWorkbook.Sheets("Tabelle1")

    Set wdApp = CreateObject("Word.Application")
    wdApp.Visible = True 
    
    Set wdDoc = wdApp.Documents.Open(wordpath)
    
    fieldNames = Array("(Vorname)", "(Name)", "(Adresse)", "(Postleitzahl)", "(Stadt)")
    
    For i = 2 To ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
        fieldValues = Array(ws.Cells(i, 1).Value, ws.Cells(i, 2).Value, ws.Cells(i, 3).Value, ws.Cells(i, 4).Value, ws.Cells(i, 5).Value)
        
        For j = LBound(fieldNames) To UBound(fieldNames)
            With wdDoc.Content.Find
                .Text = fieldNames(j) 
                .Replacement.Text = fieldValues(j)
                .Forward = True
                .Wrap = wdFindContinue
                .Format = False
                .MatchCase = True 
                .MatchWholeWord = True 
                .MatchWildcards = False
                .MatchSoundsLike = False
                .MatchAllWordForms = False
                
                ' Debuggin
                If .Execute(Replace:=wdReplaceOne) Then
                    Debug.Print "Succesfully replaced: " & fieldNames(j) & " with " & feldValues(j)
                Else
                    Debug.Print "Not found: " & fieldNames(j)
                End If
            End With
        Next j
    Next i
    
    wdDoc.SaveAs ThisWorkbook.Path & "\final_document.docx"
    wdDoc.Close
    wdApp.Quit
    
    Set wdDoc = Nothing
    Set wdApp = Nothing
    Set ws = Nothing
    
End Sub

The Debuggin console states that the replacing process was successfull but nothing changes in the final document. Log:

Succesfully replaced: (Vorname) with Vorname1
Succesfully replaced: (Name) with Name1
Succesfully replaced: (Adresse) with Adresse1
Succesfully replaced: (Postleitzahl) with Postleitzahl1
Succesfully replaced: (Stadt) with Stadt1
Succesfully replaced: (Vorname) with Vorname2
Succesfully replaced: (Name) with Name2
Succesfully replaced: (Adresse) with Adresse2
Succesfully replaced: (Postleitzahl) with Postleitzahl2
Succesfully replaced: (Stadt) with Stadt2
Succesfully replaced: (Vorname) with Vorname3
Succesfully replaced: (Name) with Name3
Succesfully replaced: (Adresse) with Adresse3
Succesfully replaced: (Postleitzahl) with Postleitzahl3
Succesfully replaced: (Stadt) with Stadt3

I'd be glad if someone could explain to me what the issue is and how i can fix it. Like I said, i cant write VBA but i can read and understand the syntax so i can make changes to the code.

Thank you in advance!


Solution

  • I'm not sure but, i think you need to add the following lines after declaring your variables at the beginning because you are using late binding for creating the Word object and probably didn't add the related reference. Without the below lines, Excel application will assign zero for these constants.

    Const wdReplaceOne = 1
    Const wdFindContinue = 1