如何使用 VBA 将 Excel 数据插入 Word，并将其导出为 PDF？答案

【问题标题】：How to use VBA to insert Excel data into Word, and export it as PDF?如何使用 VBA 将 Excel 数据插入 Word，并将其导出为 PDF？
【发布时间】：2019-08-23 15:24:38
【问题描述】：

我有一个 Excel 表，其中的行中有用于传真的信息。我需要遍历该工作表的填充行，并在每一行上打开 Word 模板。打开模板后，我需要将 Word 文档中的占位符与工作表实际行中的信息交换，然后导出为 PDF。

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsMailing As Worksheet
Set wsMailing = wb.Sheets("Mailing List")


''''''''''''''''''''''''''''''''''''''''''''''''
' SECTION  1: DOC  CREATION
''''''''''''''''''''''''''''''''''''''''''''''''

'sets up the framework for using Word 
Dim wordApp As Object
Dim wordDoc As Object
Dim owner, address1, address2, city, state, zipcode, insCo, fax1,  name, polnum As String


Dim n, j As Integer

Set wordApp = CreateObject("Word.Application")


'now we begin the loop for the mailing sheet that is being used

n = wsMailing.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

For j = 2 To n


    'first we choose which word doc gets used

        'opens the word doc that has the template  for sending out 

        Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")

        'collects the  strings needed for the document
        owner = wsMailing.Range("E" & j).Value
        address1 = wsMailing.Range("F" & j).Value
        address2 = wsMailing.Range("G" & j).Value
        city = wsMailing.Range("H" & j).Value
        state = wsMailing.Range("I" & j).Value
        zipcode = wsMailing.Range("J" & j).Value
        insCo = wsMailing.Range("K" & j).Value
        fax1 = wsMailing.Range("L" & j).Value
        name = wsMailing.Range("M" & j).Value
        polnum = wsMailing.Range("N" & j).Value


        'fills in the word doc with the missing fields
        wordDoc.Find.Execute FindText:="<<InsuranceCompanyName>>", ReplaceWith:=insCo, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Fax1>>", ReplaceWith:=fax1, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<OwnerName>>", ReplaceWith:=owner, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Address1>>", ReplaceWith:=address1, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Address2>>", ReplaceWith:=address2, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<City>>", ReplaceWith:=city, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<State>>", ReplaceWith:=state, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<ZipCode>>", ReplaceWith:=zipcode, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<Name>>", ReplaceWith:=name, Replace:=wdReplaceAll
        wordDoc.Find.Execute FindText:="<<PolicyNumber>>", ReplaceWith:=polnum, Replace:=wdReplaceAll



        'this section saves the word doc in the folder as a pdf
        wordDoc.SaveAs ("C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf")



    'need to close word now that it has been opened before the next loop

    wordDoc.Documents(1).Close

Next

当我运行它时，它会挂起并且 Excel 会冻结。我收到错误消息“Microsoft Excel 正在等待另一个应用程序完成 OLE 操作”，然后我必须重新启动计算机才能让它再次响应。

而导致程序冻结的那一行是

Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")

（当我运行它时，Microsoft Word 尚未启动并运行。它已完全关闭。）

【问题讨论】：

它到底挂在哪条线上？它是否首先正确填写了word文档？
它卡在试图打开文档的行上。 wordDoc = wordApp.Documents.Open.......
在开始创建对象时，它也没有真正打开单词app
请注意Dim owner, address1, address2, city, state, zipcode, insCo, fax1, name, polnum As String 只是将polnum 声明为String - 其余的都被声明为Variant。你应该写成Dim owner as String, address1 as String等。
这甚至不应该编译，因为您在 wordDoc.Documents(1).Close 行之前有一个没有 If 的 End If。您需要包含完整的代码 sn-p，从 Sub 到 End Sub。

标签： excel vba ms-word export-to-pdf

【解决方案1】：

首先，在我的 VBA 编辑器中，我必须转到工具 -> 参考，

...并使 Microsoft Word 16.0 对象库能够正确访问 Excel 2016 对象模型。使用不同版本的 Office，要启用的模块可能有不同的版本号。

这里我稍微改变了结构，以简化事情，但基本上没有.Content。

所以，而不是： wordDoc.Find.Execute ，这将是： wordDoc.Content.Find.Execute

所以它看起来像这样：

        With wordDoc.Content.Find
            .Execute FindText:="<<InsuranceCompanyName>>", ReplaceWith:=insCo, Replace:=wdReplaceAll
            .Execute FindText:="<<Fax1>>", ReplaceWith:=fax1, Replace:=wdReplaceAll
            .Execute FindText:="<<OwnerName>>", ReplaceWith:=owner, Replace:=wdReplaceAll
            .Execute FindText:="<<Address1>>", ReplaceWith:=address1, Replace:=wdReplaceAll
            .Execute FindText:="<<Address2>>", ReplaceWith:=address2, Replace:=wdReplaceAll
            .Execute FindText:="<<City>>", ReplaceWith:=city, Replace:=wdReplaceAll
            .Execute FindText:="<<State>>", ReplaceWith:=state, Replace:=wdReplaceAll
            .Execute FindText:="<<ZipCode>>", ReplaceWith:=zipcode, Replace:=wdReplaceAll
            .Execute FindText:="<<Name>>", ReplaceWith:=name, Replace:=wdReplaceAll
            .Execute FindText:="<<PolicyNumber>>", ReplaceWith:=polnum, Replace:=wdReplaceAll
        End With

接下来我必须更改的是 SaveAs PDF。

这会保存一个扩展名为 .pdf 的文件，但是当您实际尝试打开它时，它并没有打开。以这种方式保存的 PDF 文件，内部仍然是 Word 文档 (.docx)。就像将 Word 文档重命名为 PDF 一样。它仍然是一个 Word 文档。

这个被替换了：

wordDoc.SaveAs ("C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf")

用这个：

wordDoc.ExportAsFixedFormat "C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf", wdExportFormatPDF

最后要更改的是 Word 文档的关闭方式。这不会关闭文档，因为wordDoc 是唯一的文档，所以它不是文档的集合，因此您无法引用wordDoc 包含的第一个文档：

wordDoc.Documents(1).Close

其实很简单：

wordDoc.Close (wdDoNotSaveChanges)

必须添加wdDoNotSaveChanges 以确保您的 Word 文档模板不会与第一个 PDF 文件的内容一起保存。

如果没有这个，您的第一个 PDF 将被创建并保存，同时保存的 Word 文档包含与 PDF 文件相同的内容。

在 For 循环的第二次迭代中，没有什么可以替换，因为所有占位符 <<...>> 都将消失。

从那时起，所有 PDF 文件都将具有完全相同的内容。

我希望这会有所帮助。

整个代码块再次帮助复制和粘贴为一个单元：

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsMailing As Worksheet
Set wsMailing = wb.Sheets("Mailing List")


''''''''''''''''''''''''''''''''''''''''''''''''
' SECTION  1: DOC  CREATION
''''''''''''''''''''''''''''''''''''''''''''''''

'sets up the framework for using Word
Dim wordApp As Object
Dim wordDoc As Object
Dim owner, address1, address2, city, state, zipcode, insCo, fax1, name, polnum As String


Dim n, j As Integer

Set wordApp = CreateObject("Word.Application")

'now we begin the loop for the mailing sheet that is being used

n = wsMailing.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

For j = 2 To n


    'first we choose which word doc gets used

        'opens the word doc that has the template  for sending out

        Set wordDoc = wordApp.Documents.Open("C:\Users\cd\LEQ_VOC & Illustration Request.docx")

        'collects the  strings needed for the document
        owner = wsMailing.Range("E" & j).Value
        address1 = wsMailing.Range("F" & j).Value
        address2 = wsMailing.Range("G" & j).Value
        city = wsMailing.Range("H" & j).Value
        state = wsMailing.Range("I" & j).Value
        zipcode = wsMailing.Range("J" & j).Value
        insCo = wsMailing.Range("K" & j).Value
        fax1 = wsMailing.Range("L" & j).Value
        name = wsMailing.Range("M" & j).Value
        polnum = wsMailing.Range("N" & j).Value


        'fills in the word doc with the missing fields
        With wordDoc.Content.Find
            .Execute FindText:="<<InsuranceCompanyName>>", ReplaceWith:=insCo, Replace:=wdReplaceAll
            .Execute FindText:="<<Fax1>>", ReplaceWith:=fax1, Replace:=wdReplaceAll
            .Execute FindText:="<<OwnerName>>", ReplaceWith:=owner, Replace:=wdReplaceAll
            .Execute FindText:="<<Address1>>", ReplaceWith:=address1, Replace:=wdReplaceAll
            .Execute FindText:="<<Address2>>", ReplaceWith:=address2, Replace:=wdReplaceAll
            .Execute FindText:="<<City>>", ReplaceWith:=city, Replace:=wdReplaceAll
            .Execute FindText:="<<State>>", ReplaceWith:=state, Replace:=wdReplaceAll
            .Execute FindText:="<<ZipCode>>", ReplaceWith:=zipcode, Replace:=wdReplaceAll
            .Execute FindText:="<<Name>>", ReplaceWith:=name, Replace:=wdReplaceAll
            .Execute FindText:="<<PolicyNumber>>", ReplaceWith:=polnum, Replace:=wdReplaceAll
        End With


        ' this section saves the word doc in the folder as a pdf
        wordDoc.ExportAsFixedFormat "C:\Users\cd\" & wsMailing.Range("N" & j).Value & "_" & wsMailing.Range("C" & j).Value & ".pdf", _
                wdExportFormatPDF


    'need to close word now that it has been opened before the next loop

    wordDoc.Close (wdDoNotSaveChanges)

Next

【讨论】：