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 = "请择要转换的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 = "请选择要存放的目录" 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