Skip to content

Instantly share code, notes, and snippets.

@crykn
Last active July 19, 2026 14:51
Show Gist options
  • Select an option

  • Save crykn/460aea8dbd12d0c03b07743cbce0d070 to your computer and use it in GitHub Desktop.

Select an option

Save crykn/460aea8dbd12d0c03b07743cbce0d070 to your computer and use it in GitHub Desktop.
This is a macro for MS Word which converts all docx files in a folder to pdfs. Works on macOS as well.
Sub SaveAllDocsInFolderAsPDF()
    ' Originally from https://www.reddit.com/r/Office365/comments/1ct9c83/batch_converting_docx_files_to_pdf_files_using/

    Dim strPath As String
    Dim oDoc As Document
    Dim strFilename As String
    Dim Count As Integer

    strPath = LetUSerSelectFile("Select folder containing the .docx files", True)
    
    If strPath = "-128" Then
        MsgBox ("No folder selected, no action taken.")
        Exit Sub
    End If
    
    If Right(strPath, 1) <> PathSeparator() Then strPath = strPath & PathSeparator()

    ' Close all documents prompting to save changes
    If Documents.Count > 0 Then
        Documents.Close SaveChanges:=wdPromptToSaveChanges
    End If

    ' Loop through DOCX files in the selected folder
    strFilename = Dir$(strPath & "*.docx")

    While Len(strFilename) <> 0
        Set oDoc = Documents.Open(strPath & strFilename)
    
        oDoc.SaveAs2 FileName:=Replace(strPath & strFilename, ".docx", ".pdf"), _
                    FileFormat:=wdFormatPDF
                   
        ' Close without saving changes to the original DOCX file
        oDoc.Close SaveChanges:=wdDoNotSaveChanges

        ' Get next file
        strFilename = Dir$()
        
        Count = Count + 1
    Wend

    Dim j As Integer
    j = MsgBox(Trim(Str(Count)) & " documents converted!", vbOKOnly, "Finished")
End Sub

Function PathSeparator() As String 'Application.PathSeparator just returns '\' on macOS
    If (IsWindows) Then
        PathSeparator = "\"
    Else
        PathSeparator = "/"
    End If
End Function

Function IsWindows() As Boolean
    #If Mac Then
    IsWindows = False
    #Else
    IsWindows = True
    #End If
End Function

Function LetUSerSelectFile(DialogTitle As String, FoldersNotFiles As Boolean) As String ' returns -128 if no file was selected
    If (IsWindows) Then
        LetUSerSelectFile = FileBrowserWin(DialogTitle, FoldersNotFiles)
    Else
        LetUSerSelectFile = FileBrowserMac(DialogTitle, MacScript("return (path to documents folder) as String"), FoldersNotFiles)
    End If
End Function

Function FileBrowserWin(DialogTitle As String, FoldersNotFiles As Boolean) As String
   ' Originally from https://anywarellc.com/2021/03/31/excel-vba-file-dialog-on-a-mac/
    With Application.FileDialog(IIf(FoldersNotFiles, msoFileDialogFolderPicker, msoFileDialogFilePicker))
        .Title = DialogTitle
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        .Show
        
        If .SelectedItems.Count <> 0 Then
            FileBrowserWin = .SelectedItems.Item(1)
        Else
            FileBrowserWin = "-128"  ' what Mac OS returns when file is not selected
        End If
    End With
End Function

Function FileBrowserMac(DialogTitle As String, StartPath As String, FoldersNotFiles As Boolean) As String
  ' Originally from https://anywarellc.com/2021/03/31/excel-vba-file-dialog-on-a-mac/
  Dim sMacScript As String
  
  sMacScript = "set applescript's text item delimiters to "","" " & vbNewLine & _
    "try " & vbNewLine & _
    "set theFiles to (choose " & IIf(FoldersNotFiles, "folder", "file") & " " & _
    "with prompt """ & DialogTitle & """ default location alias """ & _
    StartPath & """ multiple selections allowed false) as string" & vbNewLine & _
    "set applescript's text item delimiters to """" " & vbNewLine & _
    "on error errStr number errorNumber" & vbNewLine & _
    "return errorNumber " & vbNewLine & _
    "end try " & vbNewLine & _
    "return theFiles"
    
    FileBrowserMac = MacScript(sMacScript)
    
    'If CInt(Split(Application.Version, ".")(0)) >= 15 ' Might only be needed for MS Office 2016+
        FileBrowserMac = Replace(FileBrowserMac, ":", "/")
        FileBrowserMac = Replace(FileBrowserMac, "Macintosh HD", "", Count:=1)
    'End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment