Skip to content

Instantly share code, notes, and snippets.

@sebnilsson
Last active August 22, 2020 03:48
Show Gist options
  • Star 7 You must be signed in to star a gist
  • Fork 1 You must be signed in to fork a gist
  • Save sebnilsson/1014112 to your computer and use it in GitHub Desktop.
Save sebnilsson/1014112 to your computer and use it in GitHub Desktop.
VBA: Loop through all files in a directory and convert them to PDF-files
Sub ConvertWordsToPdfs()
Dim directory As String
directory = "C:\Wordup" ' The starting directory
Dim fso, folder, files
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(directory)
Set files = folder.files
For Each file In files
Dim newName As String
newName = Replace(file.Path, ".doc", ".pdf")
Documents.Open FileName:=file.Path, _
ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
wdOpenFormatAuto, XMLTransform:=""
ActiveDocument.ExportAsFixedFormat OutputFileName:=newName, _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False
ActiveDocument.Close
Next
End Sub
@mmbasher
Copy link

You need to enable Reference Microsoft Word if not enabled. Thanks @sebnilsson, & @mvpjjf.

#same issue here. Error 424 any answers?

Sub ConvertWordsToPdfs()

    Dim directory As String
    Dim fldr As Object
    Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select folder with Word files to export to PDF"
        .AllowMultiSelect = False
        If .Show <> -1 Then Exit Sub
        directory = .SelectedItems(1)
    End With
    
  
    Dim fso, newFile, folder, files
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(directory)
    Set files = folder.files
    
    For Each file In files
        Dim newName As String
        newName = Replace(file.Path, ".docx", ".pdf")
        newName = Replace(newName, ".doc", ".pdf")
        'Debug.Print file.Path
        Documents.Open Filename:=file.Path, _
            ConfirmConversions:=False, _
            ReadOnly:=False, _
            AddToRecentFiles:=False, _
            PasswordDocument:="", _
            PasswordTemplate:="", _
            Revert:=False, _
            WritePasswordDocument:="", _
            WritePasswordTemplate:="", _
            Format:= _
            wdOpenFormatAuto, _
            XMLTransform:=""
            
        ActiveDocument.ExportAsFixedFormat OutputFileName:=newName, _
            ExportFormat:=wdExportFormatPDF, _
            OpenAfterExport:=False, _
            OptimizeFor:= _
            wdExportOptimizeForPrint, _
            Range:=wdExportAllDocument, _
            From:=1, To:=1, _
            Item:=wdExportDocumentContent, _
            IncludeDocProps:=True, _
            KeepIRM:=True, _
            CreateBookmarks:=wdExportCreateNoBookmarks, _
            DocStructureTags:=True, _
            BitmapMissingFonts:=True, _
            UseISO19005_1:=False
        ActiveDocument.Close
      
    Next

End Sub

@tobya
Copy link

tobya commented Dec 8, 2019

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment