Search code examples
vbaexcelms-wordmailmerge

Why are my MergeField names the only data pulling through to a PDF via MailMerge in Excel?


I am currently trying to use the code below in VBA to bring data in a table into a mailmerge word document which then saves the individual merges as a pdf. The code almost does this but when I run the macro on my excel sheet the pdf's saved only bring through the mergefield names from the word document and not the data itself.

Any ideas on where I can go from here? I am currently using Office 2016.

Sub RunMailMerge()

    Dim objWord
    Dim objDoc
    Dim StrFolder As String, StrName As String, i As Long, j As Long

    Dim strWorkbookName As String: strWorkbookName = ThisWorkbook.FullName
    Const StrNoChr As String = """*./\:?|": StrName = "Easy.docx"
    StrFolder = ThisWorkbook.Path & Application.PathSeparator

    If Dir(StrFolder & strDocNm) = "" Then Exit Sub

    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add

    With objWord

        'Disable alerts to prevent an SQL prompt
        .DisplayAlerts = wdAlertsNone
        'Display Word - change this to False once the code is running correctly
        .Visible = False
        'Open the mailmerge main document - set Visible:=True for testing
        Set objWord = .Documents.Open(Filename:=StrFolder & StrName, ReadOnly:=True,
        AddToRecentFiles:=False, Visible:=False)

        With objWord
            With .MailMerge

                'Define the mailmerge type
                .MainDocumentType = wdFormLetters
                'Define the output
                .Destination = wdSendToNewDocument
                .SuppressBlankLines = False
                'Connect to the data source
                .OpenDataSource Name:=strWorkbookName, _
                                ReadOnly:=True, _
                                LinkToSource:=False, _
                                AddToRecentFiles:=False, _
                                Format:=wdOpenFormatAuto, _
                                Connection:="User ID=Admin;DataSource=strWorkbookName;" & _
                                             "Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
                                SQLStatement:="SELECT * FROM `Sheet1                                SQLStatement:=", _
                                SubType:=wdMergeSubTypeAccess
                'Process all eligible records

                For i = 1 To .DataSource.RecordCount

                    With .DataSource
                        .FirstRecord = i
                        .LastRecord = i
                        .ActiveRecord = i
                        'Exit if the field to be used for the filename is empty
                        If Trim(.DataFields("Tenant")) = "" Then Exit For
                        'StrFolder = .DataFields("Folder") & Application.PathSeparator
                        StrName = .DataFields("Tenant")
                    End With

                    .Execute Pause:=True
                    'Clean up the filename

                    For j = 1 To Len(StrNoChr)
                        StrName = Replace(StrName, Mid(StrNoChr, j, 1), "_")
                    Next

                    StrName = "Letter - " & Trim(StrName)
                    'Save as a PDF
                    objWord.SaveAs Filename:=StrFolder & StrName & ".pdf", _
                                   FileFormat:=wdFormatPDF, AddToRecentFiles:=False
                Next i

                'Disconnect from the data source
                .MainDocumentType = wdNotAMergeDocument
            End With

            'Close the mailmerge main document
            .Close False
        End With

        Call CloseAll
        Set wdDoc = Nothing: Set wdApp = Nothing
    End With

End Sub

Sub CloseAll()

    Dim objWord
    Dim objDoc
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add

    objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

End Sub

Solution

  • That code is essentially a copy of code I've posted elsewhere (e.g. https://www.mrexcel.com/forum/general-excel-discussion-other-questions/713478-word-2007-2010-mail-merge-save-individual-pdf-files-post4796480.html#post4796480), but why you'd add your call to CloseAll is a mystery.

    Nonetheless, it's also clear you've also partially modified the code for use with late binding, by replacing:

    Dim wdApp As New Word.Application, wdDoc As Word.Document
    

    with:

    Dim objWord
    Dim objDoc
    ...
    Set objWord = CreateObject("Word.Application")
    Set objDoc = objWord.Documents.Add
    

    Had you stuck with early binding throughout, the code would work. Right now, though, your modified code employs a mix of late binding with named Word constants, which are really only applicable to early binding. You need to fully adapt the code to late binding or revert to code that is entirely early binding.