Excel MailMerge to Word Creating Duplicate Record

dsajones

New Member
Joined
May 3, 2016
Messages
26
A little while ago I picked up the following code from a forum to initiate a mailmerge from an Excel worksheet. It works fine but the resulting document is repeating the pages and the data. It's just like the spreadsheet contains two rows of data that are identical so the mailmerge is outputting all the data twice. The worksheet ReportData$ contains a heading row and then a single row of data. Any ideas why it's doing this?

Code:
Sub MergeMe1()
    Dim bCreatedWordInstance As Boolean
    Dim objWord As Object
    Dim objMMMD As Object
    Dim ClientName As String
    Dim SANum As String
    Dim cDir As String
    Dim cDir2 As String
    Dim r As Long
    Dim ThisFileName As String


    ClientName = Sheets("ReportData").Cells(2, 17).Value
    SANum = Sheets("ReportData").Cells(2, 1).Value
    ' Setup filenames
    Const WTempName = "WTCContract.docx" 
    Dim newFileName As String
    newFileName = SANum & "-" & ClientName & ".docx"


    ' Setup directories
    cDir2 = "S:\Office\BusinessSupport\ServiceAgreements\"
    cDir = ActiveWorkbook.path + "\" 
    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(cDir2 + WTempName)
    objMMMD.Activate


    'Merge the data
    With objMMMD
    .MailMerge.OpenDataSource Name:=cDir + ThisFileName, sqlstatement:="SELECT *  FROM `ReportData$`" 


        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


nextrow:


End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Have you checked the contents of the mailmerge main document (S:\Office\BusinessSupport\ServiceAgreements\WTCContract.docx), to ensure it isn't responsible for the duplications?
 
Upvote 0
Have you checked the contents of the mailmerge main document (S:\Office\BusinessSupport\ServiceAgreements\WTCContract.docx), to ensure it isn't responsible for the duplications?

Hi Macropod. Yes, that all looks fine. When I open it direct from Word it just has 8 pages and all the merged fields correctly populated from the single row in the spreadsheet. When I use the VBA mail merge code the document is 16 pages with the single row of data populating the same positions on the duplicated pages. I'm wondering if there is anything happening with the firstrecord/lastrecord. Even though there is only one record is it possible this bit is effectively looping once and thinking it's landed on a new record even though there is only one?
Code:
 With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
 
Upvote 0
The lines:
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
Simply tell Word to merge all available records. Your duplicated output suggests there are two identical rows in the data source. If there's only one record to merge you could replace them with:
.FirstRecord = 1
.LastRecord = 1
.ActiveRecord = 1
 
Upvote 0
The lines:
.FirstRecord = wdDefaultFirstRecord
.LastRecord = wdDefaultLastRecord
Simply tell Word to merge all available records. Your duplicated output suggests there are two identical rows in the data source. If there's only one record to merge you could replace them with:
.FirstRecord = 1
.LastRecord = 1
.ActiveRecord = 1

Thanks Paul. That's worked fine. I'd like to understand why it was happening though. There's definitely only one row of actual data. Row 1 is headings and row 2 is the data. I could sort of understand it if the duplication of the pages was one set with the row headings and one set with the data. But to have both sets just containing the data row is very odd.

Anyway, it's producing the desired effect now so thanks very much for your help.
 
Upvote 0
Just a final tweak I'm looking for. I actually have 2 mail merged Word documents that get generated and saved in a specific folder. All that is working great. But to make life easier for the guys using this, I'd like to be able to open the 2 word documents and leave both of them open and then save and close the spreadsheet, all controlled from the button that generates the merged document. Step by step it's:

1 - Generate first word document and merge data then save and close it. (This works fine)
2 - Generate second word document and merge data then save and close it. (This works fine)
3 - Open first word document and leave open
4 - Open second document and leave open
5 - Save and close spreadsheet

I tried commenting out the code that closes Word after generating the first document but it wouldn't then proceed to open Word to generate the second document.
 
Upvote 0
Try something along the lines of:
Code:
Sub MergeReports()
    Dim objWord As Object, objMMMD As Object
    Dim ClientName As String, SANum As String
    Dim cDir As String, cDir2 As String
    Dim r As Long
    Dim ThisFileName As String
    Dim newFileName As String, WTempName As String
    
    Const wdAlertsNone As Long = 0
    Const wdAlertsAll As Long = -1
    Const wdFormLetters As Long = 0
    Const wdSendToNewDocument As Long = 0

    ClientName = Sheets("ReportData").Cells(2, 17).Value
    SANum = Sheets("ReportData").Cells(2, 1).Value
    ' Setup filenames
    WTempName = "WTCContract.docx"


    ' Setup directories
    cDir2 = "S:\Office\BusinessSupport\ServiceAgreements\"
    cDir = ActiveWorkbook.Path + "\"
    ThisFileName = ThisWorkbook.Name

    On Error Resume Next
    ' Create a Word Application instance
    Set objWord = GetObject(, "Word.Application")
    If objWord Is Nothing Then
        Err.Clear
        Set objWord = CreateObject("Word.Application")
    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
    objWord.DisplayAlerts = wdAlertsNone

    For r = 1 To 2
        'Open Word Template
        Select Case r
          Case 1
            WTempName = "WTCContract.docx"
            newFileName = SANum & "-" & ClientName & ".docx"
          Case 2
            WTempName = "MMDocument2.docx"
            newFileName = SANum & "-" & ClientName & "(b).docx"
        End Select
        
        Set objMMMD = objWord.Documents.Open(cDir2 + WTempName, False, True, False)

        'Merge the data
        With objMMMD
            With .MailMerge
                .MainDocumentType = wdFormLetters
                .Destination = wdSendToNewDocument
                .OpenDataSource cDir + ThisFileName, , False, True, False, False, , , , , , "SELECT *  FROM `ReportData$`"
                .SuppressBlankLines = True
                With .DataSource
                    .FirstRecord = 1
                    .LastRecord = 1
                    .ActiveRecord = 1
                End With
                .Execute Pause:=False
            End With
            ' Close the Mail Merge Main Document
            .Saved = True
            .Close False
        End With

        ' Save new file
        objWord.ActiveDocument.SaveAs cDir + newFileName
    Next
    objWord.DisplayAlerts = wdAlertsAll
    objWord.Visible = True
    Set objMMMD = Nothing: Set objWord = Nothing
    ActiveWorkbook.Save
    ThisWorkbook.Save
    Appication.Quit
End Sub
Note that I've modified the code to use late binding throughout - your macro has a mix of late & early binding code. To use with two mailmerge main documents, simply edit the Case 2 statement's parameters to whatever you need for the second document. Setting objWord.DisplayAlerts = wdAlertsNone overcomes any problems that might otherwise arise if the mailmerge main documents have been connected to a data source & saved.
 
Upvote 0
Thanks for this code Paul. I will certainly give it a go. I read about late and early binding last year when I was doing something that linked to Outlook so I'll remind myself about this.
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,205
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top