Sub BatchConvertToPDF()

    Dim destFolderPath As String

    destFolderPath = GetFolderPath

    If destFolderPath <> Empty Then

        Dim path As Variant

        For Each path In GetFilePaths()

            Dim indexOfSlash, indexOfDot As Integer

            indexOfSlash = InStrRev(path, "\")

            indexOfDot = InStrRev(path, ".")

            

            Dim destFilePath As String

            destFilePath = destFolderPath + Mid(path, indexOfSlash, indexOfDot - indexOfSlash) + ".pdf"

            

            ConvertToPDF path, destFilePath

        Next path

    End If

End Sub



Function GetFilePaths()

    Dim folderPath As String

    With Application.FileDialog(msoFileDialogFilePicker)

        .Filters.Add "word文件", "*.doc; *.dotx; *.docm"

        .Title = "請(qǐng)擇要轉(zhuǎn)換的word文件"

        If .Show = -1 Then

            Set GetFilePaths = .SelectedItems

        End If

    End With

End Function



Function GetFolderPath()

    Dim folderPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)

        .AllowMultiSelect = False

        .Title = "請(qǐng)選擇要存放的目錄"

        If .Show = -1 Then

            GetFolderPath = .SelectedItems(1)

        End If

    End With

End Function



Sub ConvertToPDF(srcPath As Variant, destPath As String)

    Documents.Open FileName:=srcPath, ConfirmConversions:=False, _

        ReadOnly:=False, AddToRecentFiles:=False, PasswordDocument:="", _

        PasswordTemplate:="", Revert:=False, WritePasswordDocument:="", _

        WritePasswordTemplate:="", Format:=wdOpenFormatAuto, XMLTransform:=""

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _

        destPath, ExportFormat:= _

        wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _

        wdExportOptimizeForOnScreen, Range:=wdExportAllDocument, From:=1, To:=1, _

        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _

        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _

        BitmapMissingFonts:=True, UseISO19005_1:=False

    ActiveDocument.Close

End Sub