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
更多文章、技術交流、商務合作、聯系博主
微信掃碼或搜索：z360901061
微信掃一掃加我為好友
QQ號聯系： 360901061
您的支持是博主寫作最大的動力，如果您喜歡我的文章，感覺我的文章對您有幫助，請用微信掃描下面二維碼支持博主2元、5元、10元、20元等您想捐的金額吧，狠狠點擊下面給點支持吧，站長非常感激您！手機微信長按不能支付解決辦法：請將微信支付二維碼保存到相冊，切換到微信，然后點擊微信右上角掃一掃功能，選擇支付二維碼完成支付。
【本文對您有幫助就好】元
