【Word】批量将word转换为PDF

仅需Word软件

STPE 1： 新建空白文档，无需保存；

STPE 2： 文件 -> 选项 -> 自定义功能区 -> 勾选开发工具；

STPE 3： 在word界面选择 “开发工具” ，插入 -> 模块，复制粘贴代码；

STPE 4： 运行代码，选择包含所需转换的Word文档的文件夹。

Sub ConvertWordsToPdfs()
  
  'Updated by Extendoffice 20181123
  
  Dim xIndex As String
  Dim xDlg As FileDialog
  Dim xFolder As Variant
  Dim xNewName As String
  Dim xFileName As String
  
  Set xDlg = Application.FileDialog(msoFileDialogFolderPicker)
  
  If xDlg.Show <> -1 Then
    Exit Sub
  End If
  
  xFolder = xDlg.SelectedItems(1) + "\"
  
  xFileName = Dir(xFolder & "*.*", vbNormal)
  
  While xFileName <> ""
  
    If ((Right(xFileName, 4)) <> ".doc" Or Right(xFileName, 4) <> ".docx") Then
    
      xIndex = InStr(xFileName, ".") + 1
      xNewName = Replace(xFileName, Mid(xFileName, xIndex), "pdf")
      
      Documents.Open FileName:=xFolder & xFileName, _
        ConfirmConversions:=False, ReadOnly:=False, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto, XMLTransform:=""
        
      ActiveDocument.ExportAsFixedFormat OutputFileName:=xFolder & xNewName, _
        ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
        wdExportOptimizeForPrint, Range:=wdExportAllDocument, From:=1, To:=1, _
        Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
        CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
        BitmapMissingFonts:=True, UseISO19005_1:=False

      ActiveDocument.Close
    
    End If
    
    xFileName = Dir()
    
  Wend
  
End Sub