Sub ConvertWordToPDF()
    
    Dim sourceFolder As String
    Dim destFolder As String
    Dim fso As Object
    Dim objFolder As Object
    Dim objFile As Object
    
    '选择源文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择包含 Word 文档的文件夹"
        .Show
        If .SelectedItems.Count = 1 Then
            sourceFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    '选择目标文件夹
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "请选择用于保存 PDF 文件的文件夹"
        .Show
        If .SelectedItems.Count = 1 Then
            destFolder = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    '检查目标文件夹是否与源文件夹相同
    If StrComp(sourceFolder, destFolder, vbTextCompare) = 0 Then
        MsgBox "源文件夹和目标文件夹不能相同！", vbExclamation
        Exit Sub
    End If
    
    '创建文件系统对象
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '获取源文件夹中的所有 Word 文档
    Set objFolder = fso.GetFolder(sourceFolder)
    For Each objFile In objFolder.Files
        If UCase(fso.GetExtensionName(objFile.Path)) = "DOC" Or UCase(fso.GetExtensionName(objFile.Path)) = "DOCX" Then
            '打开 Word 文档
            Documents.Open objFile.Path
            
            '保存为 PDF 文件
            ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                destFolder & "\" & fso.GetBaseName(objFile.Path) & ".pdf", ExportFormat:=wdExportFormatPDF, _
                OpenAfterExport:=False, OptimizeFor:=wdExportOptimizeForPrint, Range:= _
                wdExportAllDocument, Item:=wdExportDocumentContent, IncludeDocProps:=True, KeepIRM:=True, _
                CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                BitmapMissingFonts:=True, UseISO19005_1:=False
            ActiveDocument.Close
        End If
    Next objFile
    
    '释放对象
    Set objFile = Nothing
    Set objFolder = Nothing
    Set fso = Nothing
    
    MsgBox Prompt:="转换完成", Buttons:=vbInformation + vbOKCancel, Title:="逗号Office技巧"
End Sub