1. 技术文章
  2. How to use VBA to insert Excel data into Word, and export it as PDF?

How to use VBA to insert Excel data into Word, and export it as PDF?

由 痴心易碎 提交于 2019-12-12 19:43:26

问题


I have an excel sheet that has information in its rows for faxing. I need to loop through the populated rows of that sheet, and open the Word template on each row. Once template is open, I need to swap placeholders in the Word doc with the information in the actual row of the worksheet, then export is as 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

When I run this, it gets hung up and Excel freezes. I get the error message "Microsoft Excel is waiting for another application to complete an OLE action" and then I have to restart the computer to get it to respond again.

And the line that causes the program to freeze is 

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

(Microsoft Word is not already up and running when I run this. It is completely closed.)


回答1:


First of all, in my case in the VBA editor I had to go to Tools -> References,

...and enable Microsoft Word 16.0 Object Library to be able to properly access Excel 2016 Object Model. With different version of Office, the module to be enabled might have a different version number.

Here I have changed the structure slightly, to simplify things, but essentially .Content was missing.

So instead of: wordDoc.Find.Execute , it would be: wordDoc.Content.Find.Execute

So it looks like this:

        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

Next thing I had to change was the SaveAs PDF thing.

This saves a file with .pdf extension, but when you actually try to open it, it doesn't open. A PDF file saved this way, inside is still a Word Document (.docx). Same as if you rename a Word Document to PDF. It is still a Word Document.

This is replaced:

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

with this:

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

Last thing to change was how the Word Document is closed. This doesn't close the document, because wordDoc is the one and only document, so it is not a collection of documents, therefore you cannot refer to the first document contained by wordDoc:

wordDoc.Documents(1).Close

Instead it is simply:

wordDoc.Close (wdDoNotSaveChanges)

wdDoNotSaveChanges had to be added to make sure that your Word document template doesn't get saved with the content of the first PDF file.

Without this your first PDF would get created and saved, together with the Word document saved containing the same as the PDF file.

In the second iteration of the For Loop there would be nothing to replace because all the placeholders <<...>> would be gone.

From then on all PDF files would have exactly the same content.

I hope this helps.

The whole code block again to help copy and paste as one unit:

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


来源：https://stackoverflow.com/questions/57629148/how-to-use-vba-to-insert-excel-data-into-word-and-export-it-as-pdf

标签
excel
vba
ms-word
export-to-pdf
易学教程内所有资源均来自网络或用户发布的内容，如有违反法律规定的内容欢迎反馈！
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!