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