Automatically replacing placeholders in different word templates via Excel

[EASE93]

Hello there,
excellent forum!

I have got an Excel workbook which contains two sheets

The first sheet contains data from Customer Base Mexico
The second sheet contains data from Customer Base Canada
I have got one template (word file) for Canadian customers and another template (word file) for Mexican customers
What I would like to achieve is that double clicking into the respective row in the Customer Base List will lead to a word file

that is based on the template for the respective Customer Base (e.g. Template Canada for Customer Base Canada)
and in which the placeholders (e.g. <<Name>> ) are replaced with the real values from the customer list (e.g. "Anita" instead of <<Name>>)



So the macro should be able to create and save a new word file based on the respective template and replace the <<placeholders>> for the real data from Excel


Would be very much appreciated if someone could help here. I have attached a "dummy" excel file and "dummy" templates.

[georgiboy]

Hi there,

That is almost a full solution you are looking for there, i will provide some code below that should help, i used the below once to replace place holders in word with address' to create stickers to stick on christmas cards. You should be able to modify the below to use on your solution.


Sub ReplaceInWord()
Dim pathh As String, oCell As Integer
Dim from_text As String, to_text As String, saveLoop As Long
Dim WA As Object, lstRow As Long, saveCount As Long

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False


pathh = ThisWorkbook.Path & "\WordFileToOpen.docx"
Set WA = CreateObject("Word.Application")

WA.Documents.Open (pathh)
WA.Visible = True


lstRow = Range("A" & Rows.Count).End(xlUp).Row

For oCell = 2 To lstRow
If Range("E" & oCell).Value <> "" Then

saveCount = saveCount + 1

from_text = "Helloworld"
to_text = Range("E" & oCell)

With WA.ActiveDocument
Set myRange = .Content
With myRange.Find
.Execute FindText:=from_text, ReplaceWith:=to_text, Replace:=1
End With
End With

If saveCount = 21 Then
'save as close then reopen here
saveLoop = saveLoop + 1
WA.ActiveDocument.SaveAs (ThisWorkbook.Path & "\Files\" & saveLoop & ".docx")
WA.ActiveDocument.Close False
WA.Documents.Open (pathh)
saveCount = 0
End If
End If
Next oCell

WA.ActiveDocument.SaveAs (ThisWorkbook.Path & "\Files\" & saveLoop + 1 & ".docx")
WA.ActiveDocument.Close False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Done"
End Sub

Maybe come back if you get stuck trying to implement the above to a double click event and making it work with two different word documents

Hope this helps