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
更多文章、技術(shù)交流、商務(wù)合作、聯(lián)系博主
微信掃碼或搜索:z360901061

微信掃一掃加我為好友
QQ號(hào)聯(lián)系: 360901061
您的支持是博主寫作最大的動(dòng)力,如果您喜歡我的文章,感覺我的文章對(duì)您有幫助,請(qǐng)用微信掃描下面二維碼支持博主2元、5元、10元、20元等您想捐的金額吧,狠狠點(diǎn)擊下面給點(diǎn)支持吧,站長非常感激您!手機(jī)微信長按不能支付解決辦法:請(qǐng)將微信支付二維碼保存到相冊(cè),切換到微信,然后點(diǎn)擊微信右上角掃一掃功能,選擇支付二維碼完成支付。
【本文對(duì)您有幫助就好】元
