Assistance needed in automating the process of populating a word template from Excel - vba

Question

I'm a complete newbie to VBA and would really appreciate some help automating a process, if anyone would be so kind. :)
I am trying to populate a Word template from an excel spreadsheet I have created
I have found some code which emables me to open my Word template, but that's as far as I'm capable of going :( lol
Private Sub PrintHDR_Click()
Dim objWord As Object
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
objWord.Documents.Open "C:\Users\Duncan\Desktop\HDR.dotx"
End Sub
The next step I wish to achieve is to copy and paste data from certain cells into my Word document.
I have set up the bookmarks in Word and have named the cells I wish to copy.
Some cells contain text, other cells contain formulas / sums which produce a numerical answer. In the cells that contain formulas or sums, it is the answer which I want copied to Word.
Any help would be much appreciated.
Thanks in advance :)
Duncan

Answer 1

I have code that does something like this. In Word, instead of using bookmarks for the fields to replace, I just use a special marker (like <<NAME>>).
You may have to adapt. I use a ListObject (the new Excel "Tables"), you can change that if you use a simple Range.
Create a "Template.docx" document, make it read-only, and place your replaceable fields there (<<NAME>>, etc.). A simple docx will do, it doesn't have to be a real template (dotx).
Public Sub WriteToTemplate()
Const colNum = 1
Const colName = 2
Const colField2 = 3
Const cBasePath = "c:\SomeDir"
Dim wordDoc As Object, sFile As String, Name As String
Dim lo As ListObject, theRow As ListRow
Dim item As tItem
Set lo = ActiveCell.ListObject
Set theRow = ActiveCell.ListObject.ListRows(ActiveCell.Row - lo.Range.Row)
With theRow.Range
'I use one of the columns for the filename:
Debug.Print "writing " & theRow.Range.Cells(1, colName).text
'A filename cannot contain any of the following characters: \ / : * ? " < > |
Name = Replace(.Cells(1, colName), "?", "")
Name = Replace(Name, "*", "")
Name = Replace(Name, "/", "-")
Name = Replace(Name, ":", ";")
Name = Replace(Name, """", "'")
sFile = (cBasePath & "\" & Name) & ".docx"
Debug.Print sFile
Set wordApp = CreateObject("word.Application")
If Dir(sFile) <> "" Then 'file already exists
Set wordDoc = wordApp.Documents.Open(sFile)
wordApp.Visible = True
wordApp.Activate
Else 'new file
Set wordDoc = wordApp.Documents.Open(cBasePath & "\" & "Template.docx")
wordApp.Selection.Find.Execute Forward:=(wordApp.Selection.Start = 0), FindText:="««NUM»»", ReplaceWith:=.Cells(1, colNum)
wordApp.Selection.Collapse direction:=1 'wdCollapseEnd
wordApp.Selection.Find.Execute FindText:="««NAME»»", ReplaceWith:=.Cells(1, colName)
wordApp.Selection.Collapse direction:=1 'wdCollapseEnd
wordApp.Selection.Find.Execute FindText:="««FIELD2»»", ReplaceWith:=.Cells(1, colField2)
wordDoc.ListParagraphs.item(1).Range.Select
wordApp.Selection.Collapse direction:=1 'wdCollapseEnd
wordApp.Visible = True
wordApp.Activate
On Error Resume Next
'if this fails (missing directory, for example), file will be unsaved, and Word will ask for name.
wordDoc.SaveAs sFile 'Filename:=(cBasePath & "\" & .Cells(1, colName))
On Error GoTo 0
End If
End With
End Sub
This basically replicates the Mail Merge function in code, to give you more control.