为什么我的MergeField是唯一通过Excel中的MailMerge拖入PDF的数据?

时间:2018-09-27 17:37:26

标签: excel vba excel-vba ms-word mailmerge

我目前正在尝试使用VBA中的以下代码将表中的数据带入mailmerge word文档中,然后将各个合并另存为pdf。代码几乎可以做到这一点,但是当我在excel工作表上运行宏时,保存的pdf仅通过word文档引入了mergefield名称,而不是数据本身。

关于我可以从这里去哪里的任何想法?我当前正在使用Office2016。

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

2 个答案:

答案 0 :(得分:0)

您为什么要尝试通过VBA代码驱动邮件合并?您应该能够A)在Excel或Access中设置数据,B)在Word中设置模板并将其连接到数据源,C)运行邮件合并。除非您确实做某事,否则就不需要VBA。

由于似乎有些虐待狂迫使您艰难地做事,因此看来您的错误很可能出现在这里:

ContentType

首先:

Connection:="User ID=Admin;DataSource=strWorkbookName;" & _
            "Mode=Read;Extended Properties=""HDR=YES;IMEX=1"";", _
            SQLStatement:="SELECT * FROM `Sheet1
            SQLStatement:=", _
            SubType:=wdMergeSubTypeAccess

应该是

Connection:="User ID=Admin;DataSource=strWorkbookName;" & _

第二,您的Connection:="User ID=Admin;DataSource=" & strWorkbookName & ";" & _ 参数是未终止的,而且我很确定SQLStatement(不确定为什么在那里有多余的引号)不是引用“表格”的方式(即工作表)从Excel工作簿中进行选择时。 IIRC,应该为"Sheet1",因此:

"WorkBook$WorkSheet"

应该是这样的:

            SQLStatement:="SELECT * FROM `Sheet1

该行之后是字符串的结尾

            SQLStatement:="SELECT * FROM " & strWorkbookName & "$Sheet1", _

其中实际SQL字符串的一部分,该字符串已发送到Excel中的数据库引擎。那是行不通的。

我的阅读方式,该行应为:

            SQLStatement:=", _

您可能需要稍微调整一下,但是我认为这会让您走上正确的轨道。

答案 1 :(得分:0)

该代码本质上是我在其他地方发布的代码的副本(例如https://www.mrexcel.com/forum/general-excel-discussion-other-questions/713478-word-2007-2010-mail-merge-save-individual-pdf-files-post4796480.html#post4796480),但是为什么要添加对CloseAll的调用却是一个谜。

尽管如此,很明显,您还替换了部分代码,以修改代码以供后期绑定使用

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

具有:

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

如果您始终坚持早期绑定,则代码将起作用。但是,现在,您的修改后的代码将后期绑定与命名的Word常量混合使用,这实际上仅适用于早期绑定。您需要使代码完全适应后期绑定,或者恢复为完全早期绑定的代码。