Question

这是场景。我在Excel 2016中使用VBA来启动与Word的邮件合并。合并的数据源是当前Excel文档中的电子表格。该例程为数据集的每次迭代生成一个单独的合并文档。

当我遍历数据集时，将创建一个新的合并文档并将其保存为PDF文档。

问题1：

该例程在循环时将创建单独的合并文档。每个合并文档都是可见的，因此，如果我遍历5个数据集，则会得到5个打开的合并文档，每个文档都具有适当的数据集值。但是，当另存为PDF时，它将一遍又一遍地保存第一个合并文档。

在我的代码中，“另存为PDF”部分基于数据集中的字段生成唯一的文件名，并且该文件名有效。每个保存的PDF都有适当的文件名，但是实际文件是第一个合并文档。

如何获取将第一个合并文档另存为PDF，然后继续进行下一个迭代的例程？

问题2：

随着例程循环并创建独立的合并文档，然后如何关闭新创建的单词合并文档？

现有代码：

z = 0
For z = 0 To xCount - 1

lb2_selected = "''" + lb2_array(0, z) + "''"

addr_query = "sp_address_filter '" + lb2_selected + "','" + lb1_selected + "','','" + lb3_selected + "','',''"
'MsgBox (addr_query)

Set rs = conn.Execute(addr_query)

'Clear any existing data from Sheet2
Worksheets("Sheet2").Range("A1:Z10000").Clear

'Load new iteration of data into Sheet2
With rs
    For h = 1 To .Fields.Count
        Sheet2.Cells(1, h) = .Fields(h - 1).Name
        Sheet2.Cells(1, h).Font.Bold = True

    Next h
End With

If Not rs.EOF Then
Sheets(2).Range("A2").CopyFromRecordset rs
End If
rs.Close

'Set value for filename
lb2_array_value = lb2_array(1, z)


Dim wd As Object
Dim wdocSource As Object

Dim strWorkbookName As String

Set wd = CreateObject("Word.Application")

    Set wdocSource = wd.Documents.Open("c:\users\john\documents\LabelPage3.docx")

    strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name

    wdocSource.MailMerge.MainDocumentType = wdFormLetters

    wdocSource.MailMerge.OpenDataSource _
            Name:=strWorkbookName, _
            AddToRecentFiles:=False, _
            Revert:=False, _
            Format:=wdOpenFormatAuto, _
            Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
            SQLStatement:="SELECT * FROM `Sheet2$`"

    With wdocSource.MailMerge
        .Destination = wdSendToNewDocument
        .SuppressBlankLines = True
        With .DataSource
            .FirstRecord = wdDefaultFirstRecord
            .LastRecord = wdDefaultLastRecord
        End With
        .Execute Pause:=False
    End With

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        "C:\users\john\documents\labels\" + lb2_array_value + ".pdf", _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

    wd.Visible = True

    wdocSource.Close SaveChanges:=False
    Set wdocSource = Nothing
    Set wd = Nothing

Next z

Answer 1

您当前的设置出现了几个问题。请考虑以下调整：

MS WORD对象：(15, ((6, ((3, 'a'), (3, ((1, 'g'), (2, 'c'))))), (9, ((4, ((2, 'f'), (2, ((1, 'b'), (1, 'd'))))), (5, 'e')))))是MS Word对象库的一部分，而不是Excel。通过不使用Word.Application对象限定它，就可以假定它适用于Excel。因此，请相应地对其进行限定：ActiveDocument。就我而言，这样做会无限期地将Excel挂起而不会出错。
早期绑定由于没有声明任何Word常量，因此您似乎已取消了对MS Word对象库的VBA引用。因此，请勿将后期绑定与早期绑定的调用混在一起：

更改以下内容：
```
wd.ActiveDocument
```
到下面：
```
Dim wd As Object
Dim wdocSource As Object

...

Set wd = CreateObject("Word.Application")
```
LOOP PROCESS ：将Word对象分配放置在循环外，因为仅需要在循环内设置和取消设置文档。并使用Application.Quit方法有效地封闭对象。
```
Dim wd As Word.Application
Dim wdocSource As Word.Document

...

Set wd = New Word.Application
```
具有块：为了易于阅读，请在Dim wd As Word.Application Dim wdocSource As Word.Document ... Set wd = New Word.Application wd.Visible = True For z = 0 To xCount - 1 ... ' SHEET QUERY PROCESS Set wdocSource = wd.Documents.Open("c:\users\john\documents\LabelPage3.docx") ... ' MAIL MERGE PROCESS wdocSource.Close SaveChanges:=False Set wdocSource = Nothing Next z wd.Quit False Set wd = Nothing进程中始终使用With...End With块：
```
MailMerge
```

错误处理：作为最佳实践，将整个过程包装在错误处理中，尤其是销毁对象，因为导致运行时错误的代码将使对象作为后台进程运行。

With wdocSource.MailMerge
    .MainDocumentType = wdFormLetters

    .OpenDataSource _
        Name:=strWorkbookName, _
        AddToRecentFiles:=False, _
        Revert:=False, _
        Format:=wdOpenFormatAuto, _
        Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
        SQLStatement:="SELECT * FROM `Sheet2$`"

    .Destination = wdSendToNewDocument
    .SuppressBlankLines = True
    With .DataSource
        .FirstRecord = wdDefaultFirstRecord
        .LastRecord = wdDefaultLastRecord
    End With
    .Execute Pause:=False
End With

VBA Excel-邮件合并到PDF遍历数据集

1 个答案: