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