Word: Batch Convert Doc to PDF

Here is a macro that will ask a user for a folder, and then convert all the DOC and DOCX files in that folder to PDF. After this the user can merge all these PDFs to create one super large PDF if they want a single file reference.

The macro will skip word documents that already have PDFs. This helps if the macro crashes - just run it again and it'll skip existing converted documents.

Public Sub BatchConvertDocToPDFRecursive()

    Dim fso, oFolder, oSubfolder, oFile, queue As Collection

    Dim strFile As String, strFolder As String

    Dim objDoc As Document

    Dim completedDocs As Integer

    Set fso = CreateObject("Scripting.FileSystemObject")

    Set queue = New Collection

    Dim dlgOpen As FileDialog

    Set dlgOpen = Application.FileDialog(FileDialogType:=msoFileDialogFolderPicker)

    With dlgOpen

        .AllowMultiSelect = True

        .Title = "Select the folder (recursive) containing all the docx (or doc) files to PDF:"

        .InitialFileName = ""

        .Show

    End With

    strFolder = dlgOpen.SelectedItems.Item(1)

    queue.Add fso.GetFolder(strFolder)

    Do While queue.Count > 0

        Set oFolder = queue(1)

        queue.Remove 1 'dequeue

        '...insert any folder processing code here...

        For Each oSubfolder In oFolder.SubFolders

            queue.Add oSubfolder 'enqueue

        Next oSubfolder

        For Each oFile In oFolder.Files

            '...insert any file processing code here...

          If Right(LCase(oFile.Path), 5) = ".docx" Or Right(LCase(oFile.Path), 4) = ".doc" Then

            Debug.Print oFile.Path

            If oFile.Attributes And 2 Then

              ' Do nothing, it's a Word temporary file that's hidden

            Else

              If Dir(Replace(Replace(oFile.Path, ".docx", ".pdf"), ".doc", ".pdf")) <> "" Then

                ' Do nothing, there's already a PDF there with the same name. This might be a re-run

              Else

                Set objDoc = Documents.Open(FileName:=oFile.Path)

                objDoc.ExportAsFixedFormat _

                  OutputFileName:=Replace(Replace(objDoc.FullName, ".docx", ".pdf"), ".doc", ".pdf"), _

                  ExportFormat:=wdExportFormatPDF, _

                  OptimizeFor:=wdExportOptimizeForPrint, _

                  Range:=wdExportAllDocument, _

                  From:=1, to:=1, _

                  Item:=wdExportDocumentWithMarkup, _

                  IncludeDocProps:=True, _

                  KeepIRM:=True, _

                  CreateBookmarks:=wdExportCreateHeadingBookmarks, _

                  DocStructureTags:=True, _

                  BitmapMissingFonts:=True, _

                  UseISO19005_1:=False, _

                  OpenAfterExport:=False

                DoEvents

                completedDocs = completedDocs + 1

                objDoc.Close SaveChanges:=wdDoNotSaveChanges

                DoEvents

                If Not (IsObject(objDoc)) Then

                  objDoc.Close SaveChanges:=wdDoNotSaveChanges ' Sometimes it doesn't close, try again

                End If

              End If

            End If

          End If

        Next oFile

    Loop

  MsgBox "Completed converting " & completedDocs & " Word Docs to PDFs"

End Sub