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

1.3k Views Asked by At

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?

1

There are 1 best solutions below

1
On

The issues with your initial code:

  1. Main error: variable wApp exists in CreateWordDocuments1, but not in CopyCell
  2. Variable PersonCell exists in CreateWordDocuments1, but not in CopyCell (same as 1st)
  3. 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:

enter image description here

.

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