View Single Post
 
Old 01-24-2021, 12:20 AM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,106
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

Without seeing either the template or the document content, the following should work to save the documents to PDF in the same folder and with the same names as the original documents.
Code:
Sub BatchToPDF()
'Graham Mayor - https://www.gmayor.com - Last updated - 24 Jan 2021 
Dim strFile As String
Dim strPath As String
Dim strName As String
Dim oDoc As Document, oNewDoc As Document
Dim fDialog As FileDialog
Const strTemplate As String = "C:\Path\Letter.dotx" 'The name and path of the template
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select folder and click OK"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Cancelled By User", , "List Folder Contents"
            Exit Sub
        End If
        strPath = fDialog.SelectedItems.Item(1)
        If Right(strPath, 1) <> "\" Then strPath = strPath + "\"
    End With

    strFile = Dir$(strPath & "*.docx")
    While strFile <> ""
        WordBasic.DisableAutoMacros 1
        Set oDoc = Documents.Open(strPath & strFile)
        Set oNewDoc = Documents.Add(strTemplate)
        oNewDoc.Range.FormattedText = oDoc.Range.FormattedText
        strName = Replace(oDoc.FullName, ".docx", ".pdf")
        oDoc.Close 0
        oNewDoc.ExportAsFixedFormat OutputFileName:=strName, _
                                    ExportFormat:=wdExportFormatPDF, _
                                    OpenAfterExport:=False, _
                                    OptimizeFor:=wdExportOptimizeForPrint, _
                                    Range:=wdExportAllDocument, from:=1, To:=1, _
                                    Item:=wdExportDocumentContent, _
                                    IncludeDocProps:=True, _
                                    KeepIRM:=True, _
                                    CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                    DocStructureTags:=True, _
                                    BitmapMissingFonts:=True, _
                                    UseISO19005_1:=False
        oNewDoc.Close 0
        WordBasic.DisableAutoMacros 0
        strFile = Dir$()
    Wend
lbl_Exit:
    Exit Sub
End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote