批量打印文件下的word文件为PDF文件（含代码）

存在问题

目前某个文件夹存在着成千上万个WORD文件，需要将每个文件都转换成PDF文件，手动转换的繁杂并且工作量太大，是否可以利用VBA代码实现该功能

实现过程

打开任意一个表格，对着子表名称右键调用代码窗口或者ALT+F11调用代码窗口，插入模块，复制第三章节的代码进去，F5执行代码，会先弹出一个选择word存放的根目录窗口，选择完成后会继续选择一个存放PDF的窗口，选择“是”的话会和原来的word存放在同一个根目录下，如果选择“否”的话则自行选择存放的根目录，继续执行代码，直到全部转换成PDF文件，亲测可用。

实现代码

'打开文件夹，手动选择word文件所在的文件夹，逐个打开word文件并保存成PDF文件
Sub ConvertWordToPDFWithDialog()
Dim FolderPath As String
Dim FileName As String
Dim WordApp As Object
Dim WordDoc As Object
Dim FolderDialog As FileDialog
Dim SaveDialog As FileDialog
Dim StartTime As Double
Dim EndTime As Double
Dim ElapsedTime As Double
Dim PDFPath As String
Dim SameDirectory As VbMsgBoxResult
Dim RootDirectory As String
Dim FirstSelection As Boolean
FirstSelection = True ’ 设置为首次选择目录

' 记录开始时间
StartTime = Timer

' 打开文件夹选择对话框
Set FolderDialog = Application.FileDialog(msoFileDialogFolderPicker)

With FolderDialog
    If .Show = -1 Then
        FolderPath = .SelectedItems(1) & "\"
    Else
        Exit Sub
    End If
End With

' 创建一个新的Word应用程序实例（后期绑定）
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = False ' 设置Word应用程序不可见

' 提示用户选择保存目录，仅询问一次
SameDirectory = MsgBox("是否要将PDF文件保存在与Word文件相同的目录？" & vbNewLine & "选择[是]以保存在同一个目录，选择[否]以手动选择根目录。", vbYesNo + vbQuestion, "保存目录选择")

If SameDirectory = vbNo Then
    ' 打开文件夹选择对话框，只需要选择一次根目录
    Set SaveDialog = Application.FileDialog(msoFileDialogFolderPicker)
    
    With SaveDialog
        If .Show = -1 Then
            RootDirectory = .SelectedItems(1) & "\"
        Else
            ' 用户取消了选择，跳过保存
            Exit Sub
        End If
    End With
End If

' 循环处理文件夹下的每个Word文件
FileName = Dir(FolderPath & "*.doc*")
Do While FileName <> ""
    ' 打开Word文档
    Set WordDoc = WordApp.Documents.Open(FileName:=FolderPath & FileName, ReadOnly:=True)

    If SameDirectory = vbYes Then
        ' PDF文件保存在相同目录
        PDFPath = FolderPath & Left(FileName, Len(FileName) - 5) & ".pdf"
    ElseIf SameDirectory = vbNo Then
        ' 使用根目录
        PDFPath = RootDirectory & Left(FileName, Len(FileName) - 5) & ".pdf"
    Else
        ' 用户选择取消，跳过保存
        Exit Do
    End If

    ' 保存为PDF
    WordDoc.ExportAsFixedFormat OutputFileName:=PDFPath, ExportFormat:=17 ' 17 表示PDF格式

    ' 关闭Word文档
    WordDoc.Close False

    ' 继续下一个文件
    FileName = Dir
Loop

' 记录结束时间
EndTime = Timer

' 关闭Word应用程序
WordApp.Quit
Set WordApp = Nothing
Set WordDoc = Nothing

' 计算运行时间
ElapsedTime = EndTime - StartTime

' 弹出提示框显示运行时间
MsgBox "转换完成！总运行时间: " & ElapsedTime & " 秒"

End Sub