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!
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