Populate word from excel template each row=one document through bookmarks - vba

Question

I'm getting the error
"error 424" - object required
on the marked line:
Sub CreateWordDocuments1()
Const FilePath As String = "D:\"
Dim wApp As Word.Application
Dim wDoc As Word.Document
Set wApp = CreateObject("word.application")
wApp.Visible = True
Dim PersonCell As Range
'create copy of Word in memory
Dim PersonRange As Range
'create a reference to all the people
Range("A1").Select
Set PersonRange = Range( ActiveCell, ActiveCell.End(xlDown))
'for each person in list �
For Each PersonCell In PersonRange
'open a document in Word
Set wDoc = wApp.Documents.Open("D:\template.doc")
'go to each bookmark and type in details
CopyCell "FirstName", 1
'save and close this document
wDoc.SaveAs2 FilePath & "person " & PersonCell.Value & ".doc"
wDoc.Close
Next PersonCell
wApp.Quit
MsgBox "Created files in " & FilePath & "!"
End Sub
Sub CopyCell(BookMarkName As String, ColumnOffset As Integer)
'copy each cell to relevant Word bookmark
wApp.Selection.GoTo What:=-1, Name:="FirstName" ''' Error on this line
wApp.Selection.TypeText PersonCell.Offset(0, ColumnOffset).Value
End Sub
Also, I am trying for whole day to skip this error but I can't. I search for some alternatives such as XML maybe?

Answer 1

The issues with your initial code:
Main error: variable wApp exists in CreateWordDocuments1, but
not in CopyCell
Variable PersonCell exists in CreateWordDocuments1, but not in CopyCell (same as 1st)
CopyCell doesn't use parameter BookMarkName (not critical but made it redundant)
.
Edited code to accommodate multiple Word bookmarks in synch with Excel columns
Here is how all files are setup - column names in Excel represent Bookmark names in Word:
.
Option Explicit
Public Sub CreateWordDocuments()
Const FILE_PATH As String = "C:\Tmp\"
Const FILE_NAME As String = "Template"
Const FILE_EXT As String = ".doc"
Dim wApp As Word.Application
Dim wDoc As Word.Document
Dim totalRows As Long 'assumes all columns are the same size
Dim totalCols As Long 'assumes all rows are the same size
Dim person As Long 'Outer loop counter (all rows)
Dim personList As Variant 'All data: rows and columns, without header row
Dim bookmark As Long 'Inner loop counter (all columns)
Dim bookmarks As Variant 'All bookmarks, from the header row
Set wApp = CreateObject("Word.Application")
wApp.Visible = False
'We're working in Sheet1, and data starts in its first cell (A1)
With ThisWorkbook.Worksheets(1)
With .UsedRange
bookmarks = .Rows(1).Value2 'get all column headers
totalRows = .Rows.Count
totalCols = .Columns.Count
End With
'all data without the header row -------------------------------------
personList = .Range(.Cells(2, 1), .Cells(totalRows, totalCols)).Value2
End With
For person = 1 To totalRows - 1 'each row (after header)
'Open Word Template file
Set wDoc = wApp.Documents.Open(FILE_PATH & FILE_NAME & FILE_EXT)
For bookmark = 1 To totalCols 'each column
With wApp.Selection
'bookmark name from header row
.GoTo What:=wdGoToBookmark, Name:=bookmarks(1, bookmark)
'enter data for each bookmark
.TypeText personList(person, bookmark)
End With
Next 'next column \ bookmark
With wDoc 'sava and close the new Word file (person name in column 1)
.SaveAs FILE_PATH & "Person " & personList(person, 1) & " " & personList(person, 2) & FILE_EXT
.Close
End With
Next 'next row
wApp.Quit
Set wDoc = Nothing
Set wApp = Nothing
MsgBox "Created " & totalRows - 1 & " files in " & FILE_PATH
End Sub