' 将Word文件(doc和docx)批量转换成PDF文件 ' 使用的是Word的另存为功能

Word2PDF.vba

Sub Word2PDF()
'
' 将Word文件(doc和docx)批量转换成PDF文件
' 使用的是Word的另存为功能
'


Application.ScreenUpdating = False
Application.DisplayAlerts = wdAlertsNone

'关掉部分错误提示

Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "请选择文件夹"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    If .Show <> -1 Then
        Exit Sub
    End If
    sItem = .SelectedItems(1)
End With

getfolder = sItem
Set fldr = Nothing

'上面是获取文件夹

Files = Dir(getfolder & "\*.doc*")

On Error Resume Next

While Files <> ""
    ChangeFileOpenDirectory getfolder
    Documents.Open FileName:=Files, _
        ConfirmConversions:=False, ReadOnly:=True, AddToRecentFiles:=False, _
        PasswordDocument:="", PasswordTemplate:="", Revert:=False, _
        WritePasswordDocument:="", WritePasswordTemplate:="", Format:= _
        wdOpenFormatAuto, XMLTransform:=""
    '打开文件
    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
        getfolder & "\" & Files & ".pdf", _
        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
    '将打开的文件导出为PDF文件
    ActiveDocument.Close (0)
    Files = Dir
Wend
'打开所有文件，另存为PDF文件

Application.ScreenUpdating = True
Application.DisplayAlerts = wdAlertsAll

'打开错误提示

End Sub