Using VBA to loop through multiple Word Templates and fill them in with Excel Data

[AppellatePerson]

I am trying to put data from one row in an Excel file into a bunch of different Word templates at bookmarked locations. Each row in the spreadsheet pertains to an employee. Basically, I have over 30 document templates (for different purposes) that need to be filled out for about 20 different people. Then, I need to save those filled out documents as Word templates themselves. Each employee needs a personalized version of the template but it has to stay a template so that they can use it repeatedly to create new copies of those documents to edit for a particular customer.

Here is a dummy version of the type of data the Excel file will be putting into the templates at various locations:

For MrExcel Post.xlsm
	A	B	C	D	E
1	Employee Name	Employee Number	Email	Title	Initials
2	John Smith	123435	test@aol.com	Employee1	JS
3	Donald Duck	2346534	test2@aol.com	Employee2	DD
4	Tom Cruise	4687876	test3@aol.com	Employee3	TC
Names_Info

Mail merge is not the answer because I need to apply the information to thirty different template documents. Doing a mail merge creates one document containing the version for each employee. It is too cumbersome to do the mail merge and then separate that one output document into 20 different documents. And then repeat that whole process 29 more times for all the different templates.

I found an answer on Quora about using bookmarks in the Word template and a VBA module applying data from an Excel file. That answer from Danielle O'Connell is available here but here is the code:

Sub SendToMemo()
'Creates a new memo using the details of the selected row.
 
Dim wd As Object
Dim wdDoc As Object
Dim r As Integer
Dim h As Integer
Dim lCol As Integer
Dim strV As String
Dim strH As String
Dim strBM As String
Dim wdBM As Object
Dim i As Integer
 
'Create Word Document & Set Object References
    Set wd = CreateObject("Word.Application")
    Set wdDoc = wd.Documents.Add("C:\Users\danie\Documents\test\Test Template.dotx")
    wd.Visible = True
 
'Loop through each column and retreive heading text and cell text (strH = Heading Text, strV = cell Text)
    r = ActiveCell.row
    lCol = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column
    h = 1
        While h <= lCol
            strH = Replace(Replace(Replace(Replace(ActiveSheet.Cells(1, h).Value, " ", "_"), ",", ""), "-", ""), ".", "")
            strV = ActiveSheet.Cells(r, h).Text
            strBM = strH
            i = 1
     
'Test if Bookmark named with column heading exists
lbTestBM:
        If wdDoc.Bookmarks.Exists(strBM) Then
            wdDoc.Bookmarks(strBM).Range.Text = strV
         
 'Test if multiple bookmarks with same name exist using column heading & iterating integer
                i = i + 1
                strBM = strH & "_" & i
                GoTo lbTestBM
            End If
        h = h + 1
        Wend
End Sub

This code worked like a charm for one of the Word templates but I need help to make it do what I need for all the documents.

The remaining problems I need to solve are how to get the VBA module to:

• apply the Excel data to more than one template file (about 30 files). One option I considered is putting all the templates into a single folder and then looping through every file in that folder.
• Have the output files be Word templates ( .dotm) files.
• "Save as" the new Word documents. Otherwise, I have to save 600 documents manually.
• Name the files with a descriptive name. Ideally, the name would be the employee's initials + the template title. I think this could be done by referring to the "Initials" column in the Excel file.
• Not a huge deal but it is probably best to have the files not open automatically when the VBA module creates them.

I have no VBA experience but have enjoyed tinkering with it so far. I learned some basic Java in college so I have a very basic understanding of coding principles. Please have mercy on me and help me out!

 

[John_w]

I will continue to help you until it's working properly.

First, close Word if it's running and then use Task Manager to kill/delete any WINWORD.exe processes.

If Word isn't open before running the macro the code creates a hidden instance of Word. Remove the apostrophe from the start of this line so that the Word app is shown:

        'WordApp.Visible = True

Are the outputFolder and matchWordTemplates strings set to different folders? They should be.

Now test the macro with say 3 templates and 4 or 5 employees.

 

[AppellatePerson]

I will continue to help you until it's working properly.

First, close Word if it's running and then use Task Manager to kill/delete any WINWORD.exe processes.

If Word isn't open before running the macro the code creates a hidden instance of Word. Remove the apostrophe from the start of this line so that the Word app is shown:

        'WordApp.Visible = True

Are the outputFolder and matchWordTemplates strings set to different folders? They should be.

Now test the macro with say 3 templates and 4 or 5 employees.

John, thank you for continuing to help me. I think it will be perfect after crushing one (somewhat minor) bug.

I closed Word and restarted my computer. I did not see any WINWORD processes on task manager. I put 3 templates in the template folder and used an Excel file with 3 employees. I checked outputFolder and matchWordTemplates and they are set to different folders, although the out put one is inside the other. Is that a problem? I removed the apostrophe so the line of code is active.

I ran the macro and it took a pretty long time to run but did eventually finish successfully with the "Done" dialog box. When I ran the macro, it made all 9 new templates and the bookmark substitution worked, so that is awesome! The macro also made 3 output template files that were named with no initials and then the original template name. When I open those blank-named templates, the substitution spots are blank. I was watching the output folder while it ran and it seemed like it was looping over and over after it finished the last employee's version of each template. Then it made the blank version and eventually moved on to the next original template document.

It is definitely working but it would be better if it would not do that looping after the last line of Excel data/blank document creation. That seemed to really slow it down. Not a huge deal but with 30 templates and 20 employees it will probably take a long time for the macro to finish.

 

[John_w]

I checked outputFolder and matchWordTemplates and they are set to different folders, although the out put one is inside the other. Is that a problem?

That's OK.

The 3 output template files with no initials sounds like your Excel data has some blank cells, which the sheetData array has read from the sheet. Try changing this line:

        sheetData = .UsedRange.Value

to:

        sheetData = .Range("A1").CurrentRegion.Value

Add the following line after that line and confirm whether the correct number of rows and columns have been read from the sheet (the number includes the header row, row 1)

        MsgBox "Rows " & UBound(sheetData) & vbCr & "Columns " & UBound(sheetData, 2)

 

[AppellatePerson]

THAT DID IT!!! it did not hang up at the end and it reported the correct number of rows (4) and columns (5). And no blank output files! This is just so amazing! It is a total gamechanger for how we deal with this extremely tedious, error prone, and time-consuming task. You have no idea how thankful I am, John. Know that this internet stranger owes you a huge debt of gratitude. You truly are a "Mr.Excel MVP." Thank you thank you thank you!

I hope you have a wonderful weekend

 

[John_w]

That's brilliant! I'm really pleased it's all working now and you have a macro to automate a tedious manual task.

Have a great weekend too.