Batch create single PDF file from Multiple Word Docs

winchmatt3

New Member
Joined
Dec 22, 2014
Messages
5
Currently I have code that creates a single PDF file from multiple Word Docs. I am manually storing the file paths of the files in Cells B2 - B100 like this:

AB
1"C:\Filepath_Here.doc"
2"C:\Filepath_Doc2_Here.doc"
3"C:\Filepath_Doc3_Here.doc"

<tbody>
</tbody>

I need to improve the code so that I can select multiple Word Docs using the File Picker Menu and create a single PDF from that. I am trying to avoid having to stuff all the document filepaths in the worksheet.

Code:
Sub MakePDF()    Dim wdDoc As Word.Document
    Dim wdApp As Word.Application
    Dim bNewApp As Boolean
    Dim sh As Worksheet
    Dim r As Integer
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    On Error GoTo 0
    If wdApp Is Nothing Then
        Set wdApp = CreateObject("Word.Application")
        bNewApp = True
    End If
    Set wdDoc = wdApp.Documents.Add
    wdApp.Visible = True


    Set sh = ActiveWorkbook.Worksheets("Sheet1")
    With sh.Sort
        .SortFields.Add Key:=Range("A1"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange ActiveWorkbook.Worksheets("Sheet1").UsedRange
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    r = 1
    Do Until sh.Cells(r, 1).Value = ""
        If Len(wdDoc.Range) > 0 Then
            wdDoc.Bookmarks("\EndOfDoc").Range.InsertBreak wdPageBreak
        End If
        wdDoc.Bookmarks("\EndOfDoc").Range.InsertFile Filename:=sh.Cells(r, 2).Value
        r = r + 1
    Loop
    wdDoc.SaveAs "C:\Users\501290691\Desktop\TEST_MERGE\MyPDF.PDF", wdFormatPDF
    wdDoc.Close wdDoNotSaveChanges
    If bNewApp Then
        wdApp.Quit
    End If
End Sub

Can anyone offer suggestions for me?

Much appreciated!
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest

Forum statistics

Threads
1,215,081
Messages
6,123,016
Members
449,093
Latest member
ikke

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top