VBA Mail Merge adding unwanted pages

jeffalex2 · July 27th, 2011, 08:04 AM

Using Office 2007, I am using the following code to create a merge document from Excel to a pre-linked merge document with header and footer which also contain merge fields. Everything works well, except, at the end of my document, I am getting two blank pages that are very hard to delete. Also, I am only creating the merge from one record. BTW, when it creates the new blank pages, it also duplicates pre-inserted text. The entire merge doc is one format type: no spacing after paragraphs

How do I get Word to NOT create the additional pages?

Thanks in advance for any help!

Code:

Option Explicit 
Const wdDefaultFirstRecord = 1 
Const wdFormatDocument = 0 
Const wdDefaultLastRecord = -16 
Const wdFormLetters = 0 
Const wdOpenFormatAuto = 0 
Const wdSendToNewDocument = 0 
Const wdFormatXMLDocumentMacroEnabled = 13 
 
 
Private Sub cmdbtnGenerateContract_Click() 
    ThisWorkbook.Save 
    Dim objWrd As Object 
    Dim objMergeDoc As Object 
    Dim objNewDoc As Object 
    Dim strPath As String 
    Dim strMergeDoc As String 
    Dim strNewDoc As String 
    Dim strDataSrc As String 
    Set objWrd = CreateObject("Word.Application") 
    strPath = ThisWorkbook.Path 
    strMergeDoc = "Contract Merge.dotx" 
    strNewDoc = ThisWorkbook.Worksheets("Customer").Range("C5").Value & " - " & ThisWorkbook.Worksheets("Customer").Range("C6").Value 
    strDataSrc = ThisWorkbook.FullName 
    Set objMergeDoc = objWrd.Documents.Open(strPath & Application.PathSeparator & strMergeDoc) 
     
    With objMergeDoc.MailMerge 
        .MainDocumentType = wdFormLetters 
        .OpenDataSource Name:=strDataSrc, LinkToSource:=True, Format:=wdOpenFormatAuto, _ 
        Connection:="Provider=Microsoft.ACE.OLEDB." & Application.Version & ";User ID=Admin;Data Source=" & strDataSrc & ";Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type", SQLStatement:="SELECT * FROM `ContractMergeData$`" 
        .Destination = wdSendToNewDocument 
        .SuppressBlankLines = 1 
        With .DataSource 
            .FirstRecord = wdDefaultFirstRecord 
            .LastRecord = wdDefaultLastRecord 
        End With 
        .Execute 0 
    End With 
    objMergeDoc.Close 0 
    Set objNewDoc = objWrd.Documents(objWrd.Documents.Count) 
    objNewDoc.SaveAs Filename:=strPath & Application.PathSeparator & strNewDoc, FileFormat:=wdFormatDocument 
    objWrd.Visible = True 
     'objWrd.Quit 0
    MsgBox "Save Complete" & vbLf & vbLf & "File saved in " & strPath & Application.PathSeparator & strNewDoc, vbOKOnly + vbInformation, "File Created" 
     
End Sub