Automating Mail Merge using Excel VBA

Question

I created a macro in Excel where I can mail-merge data from Excel into Word Letter Template and save the individual files in the folder.

I have Employee data in Excel and I can generate any Employee letter using that Data and can save the individual Employee letter as per the Employee name.

I have run mail-merge automatically and save individual files as per the Employee name. And every time it runs the file for one person it will give the status as Letter Already Generate so that it wont duplicate any Employee records.

The problem is the output in all the merged files the output is same as the first row. Example: if my Excel has 5 Employee details I am able to save the 5 individual merged files on each employee name, however the merged data if of the first employee who is in Row 2.

My rows have the below data:

Row A: has S.No.
Row B: has Empl Name
Row C: has Processing Date
Row D: has Address
Row E: Firstname
Row F: Business Title
Row G: Shows the status (if the letter is generated it shows "Letter Generated Already" after running the macro or it shows blank if it is new record entered.

Also how can I save the output (merged file) also in PDF other than DOC file so the merged files will be in two formats one in DOC and the other one in PDF formats?

Sub MergeMe()

Dim bCreatedWordInstance As Boolean
Dim objWord As Word.Application
Dim objMMMD As Word.Document
Dim EmployeeName As String
Dim cDir As String
Dim r As Long
Dim ThisFileName As String
lastrow = Sheets("Data").Range("A" & Rows.Count).End(xlUp).Row
r = 2
For r = 2 To lastrow
If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow
EmployeeName = Sheets("Data").Cells(r, 2).Value

' Setup filenames
Const WTempName = "letter.docx" 'This is the 07/10 Word Templates name,  Change as req'd
Dim NewFileName As String
NewFileName = "Offer Letter - " & EmployeeName & ".docx" 'This is the New 07/10 Word Documents File Name, Change as req'd"

' Setup directories
cDir = ActiveWorkbook.path + "\" 'Change if appropriate
ThisFileName = ThisWorkbook.Name

On Error Resume Next

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
End If

If objWord Is Nothing Then
MsgBox "Could not start Word"
Err.Clear
On Error GoTo 0
Exit Sub
End If

' Let Word trap the errors
On Error GoTo 0

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir + WTempName)
objMMMD.Activate

'Merge the data
With objMMMD
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT *  FROM `Data$`"   ' Set this as required

With objMMMD.MailMerge  'With ActiveDocument.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
  .FirstRecord = wdDefaultFirstRecord
  .LastRecord = wdDefaultLastRecord
End With
.Execute Pause:=False
End With
End With

' Save new file
objWord.ActiveDocument.SaveAs cDir + NewFileName

' Close the Mail Merge Main Document
objMMMD.Close savechanges:=wdDoNotSaveChanges
Set objMMMD = Nothing

' Close the New Mail Merged Document
If bCreatedWordInstance Then
objWord.Quit
End If

0:
Set objWord = Nothing
Cells(r, 7).Value = "Letter Generated Already"
nextrow:

Next r

End Sub

OpiesDad · Answer 1 · 2016-12-14T18:25:06.300

6

To save the file in pdf format use

objWord.ActiveDocument.ExportAsFixedFormat cDir & NewFileName, _
                  ExportFormat:=wdExportFormatPDF

It looks to me that when you are executing the mail merge, it should create a file with ALL of the letters, so when you open it, it would appear that the first letter is the one that is getting saved, but if you scroll down the word file that you have saved, you may find each letter on a new page.

Instead, you want to execute the merge one letter at a time.
To fix this, change the lines as follows:

With .DataSource
  .FirstRecord = r-1
  .LastRecord = r-1
  .ActiveRecord = r-1

You need to use r-1 because Word is going to use the record number in its dataset, and since the data starts in row 2, and the counter r is related to the row, you need r-1.

You don't need to open up word each time, so put all of the code setting the datasource of the mail merge and creating the word doc outside of your main loop.

Const WTempName = "letter.docx" 'This is the 07/10 Word Templates name,  
Dim NewFileName As String

' Setup directories
cDir = ActiveWorkbook.path + "\" 'Change if appropriate
ThisFileName = ThisWorkbook.Name

On Error Resume Next

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
End If

If objWord Is Nothing Then
    MsgBox "Could not start Word"
    Err.Clear
    On Error GoTo 0
    Exit Sub
End If

' Let Word trap the errors
On Error GoTo 0

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir + WTempName)
objMMMD.Activate

'Merge the data
With objMMMD
.MailMerge.OpenDataSource Name:=cDir + ThisFileName, _
    sqlstatement:="SELECT *  FROM `Data$`"   ' Set this as required

For r = 2 To lastrow
    If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow
'rest of code goes here

Also, instead of checking the Excel file for the Employee name to create the file name, you could do this after you merge the document. For me, this is a little more intuitive to link the file name to the letter you have just merged. To do this update the line further to:

With .DataSource
  .FirstRecord = r-1
  .LastRecord = r-1
  .ActiveRecord = r-1
  EmployeeName = .EmployeeName 'Assuming this is the field name

Then immediately before saving the file you can do this:

 ' Save new file
NewFileName = "Offer Letter - " & EmployeeName & ".docx"
objWord.ActiveDocument.SaveAs cDir + NewFileName

Hope this helps.

edited Dec 14 '16 at 18:25

answered Feb 18 '15 at 15:37

OpiesDad

3,385
2
16
31

Thank you for the answer, after executing I have understood that I am able to execute mail merge all in one file, but my requirement is to generate individual letters for each employee. As I have to provide Individual letter to more than 500 Employees hence need a updated macro when I input the data into my excel Data file and run a macro button all the mail-merged data will be saved automatically both in PDF and Doc for individual employee, example If I run a macro for 500 Employees I should have 500 individual files merged with their data only & save with their respective Names. Please help – Hema Feb 19 '15 at 07:44
Hema, The answer that I provided fixes your issues. Please read it more closely. – OpiesDad Feb 19 '15 at 15:06
Dear OpiesDad My Apologies, as you said yes this code is working great for me only problem is "EmployeeName = .EmployeeName 'Assuming this is the field name" showing error I am unable to save the file on each individual name. Please advise. – Hema Feb 20 '15 at 17:30
You need to put whatever the column name is that is in the excel file. So if in the "Data" sheet, the column heading for the Employee Name is "EmpName", then the line needs to be: "EmployeeName = .EmpName" – OpiesDad Feb 20 '15 at 17:39
My Column Heading is EmployeeName hence added the line as it is "EmployeeName = .EmployeeName" still getting error "Complie Error: syntax error" and highlighting this line. I know I am bugging you on this but serious require your help. Thank you sooooo much. :-) – Hema Feb 20 '15 at 17:54
Also If I just add EmployeeName=".EmployeeName" then it is saving only one file (for the first row info) and then throwing a Run-time error '91': Object Variable or with block variable not set. I think this is because there is already a file name as "Offer Letter - .EmployeeName.docx" – Hema Feb 20 '15 at 18:04
Oh, I see the problem. There shouldn't be any quotes and this line needs to be within the "With" statement. See above edit showing the end of the With statement. – OpiesDad Feb 20 '15 at 18:27
I'm having a hard time editing the post, but the code should be "With .DataSource .FirstRecord = r - 1 .LastRecord = r-1 .ActiveRecord = r-1 EmployeeName = .EmployeeName End With" where stands for a newline. – OpiesDad Feb 20 '15 at 18:35
Hi OpiesDad thank you for all the help I have tried to execute using the above changes but couldn't succeed. The major problem encountered is I am unable to run bulk files in one mail merge. When executing more than one mail-merge encountering Runtime Error: 91 (Object variable or with block variable not set) and highlighting the statement "With objMMMD.MailMerge 'With ActiveDocument.MailMerge". Please do advise. – Hema Feb 23 '15 at 07:15
You need to put the "set objMMMD = Nothing" line OUTSIDE of the for loop. Otherwise you no longer have a reference to the open word document in the second loop. Similarly, the "objword.quit" line needs to be outside of the loop or the file and Word will no longer be open. – OpiesDad Feb 23 '15 at 14:46
Sadly this didn't work OpiesDad I have implemented the same but some how is it is showing the same Runtime Error: 91. Don't know what is wrong. – Hema Feb 27 '15 at 05:12

score 0 · Answer 2 · answered Apr 14 '22 at 19:23

The following code works as intended. It saves one .docx and one .pdf file for each entry in the data table while following OpiesDad's recommendations.

Before running, check if the VBA library for Word (Microsoft Word 16.0 Object Library) is activated and make the connection to the Excel data table from the Word template (Mail Merge settings).

Sub MergeMe()

Application.ScreenUpdating = False

Dim bCreatedWordInstance As Boolean
Dim objWord As Word.Application
Dim objMMMD As Word.Document
Dim EmployeeName As String
Dim cDir As String
Dim r As Long
Dim ThisFileName As String
lastrow = Sheets("Dados").Range("A" & Rows.Count).End(xlUp).Row
r = 2

' Setup filenames
Const WTempName = "Proposta.docx" 'Word Template name,  Change as req'd
Dim NewFileName As String

On Error Resume Next

' Setup directories
cDir = ActiveWorkbook.Path + "\" 'Change if appropriate
ThisFileName = ThisWorkbook.Name

' Create a Word Application instance
bCreatedWordInstance = False
Set objWord = GetObject(, "Word.Application")

If objWord Is Nothing Then
  Err.Clear
  Set objWord = CreateObject("Word.Application")
  bCreatedWordInstance = True
End If

If objWord Is Nothing Then
MsgBox "Could not start Word"
Exit Sub
End If

' Set to True if you want to see the Word Doc flash past during construction
objWord.Visible = False

'Open Word Template
Set objMMMD = objWord.Documents.Open(cDir + WTempName)

'loop through each table row
For r = 2 To lastrow

    If Cells(r, 7).Value = "Letter Generated Already" Then GoTo nextrow
    
    objMMMD.Activate
    
    'Merge the data
    With objMMMD
    
    .MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT *  FROM `Dados$`"   ' Set this as required
    
        With objMMMD.MailMerge  'With ActiveDocument.MailMerge
        
            .Destination = wdSendToNewDocument
            .SuppressBlankLines = True
            
                With .DataSource
                    .FirstRecord = r - 1
                    .LastRecord = r - 1
                    .ActiveRecord = r - 1

                     EmployeeName = .DataFields("Nome").Value 'Change "Nome". to the column name for employee names"
                     
                End With
               
            .Execute Pause:=False 'executes the mail merge
        End With
        
    End With
    
On Error GoTo 0

' Save new file (.docx & .pdf) and close it
NewFileName = "Offer Letter - " & EmployeeName  'Word Document File Name, Change as req'd"
objWord.ActiveDocument.SaveAs cDir + NewFileName + ".docx"

objWord.ActiveDocument.ExportAsFixedFormat cDir + NewFileName + ".pdf", _
                  ExportFormat:=wdExportFormatPDF

objWord.ActiveDocument.Close

Cells(r, 7).Value = "Letter Generated Already"

nextrow:
Next r

objMMMD.Close False
objWord.Quit

Application.ScreenUpdating = True

End Sub

Automating Mail Merge using Excel VBA

2 Answers2

Linked