iReg小程序:Word批量转PDF (2026年最新版)

Private Sub CommandButton1_Click()    ' 定义变量    Dim fso As Object    Dim sourceFolder As String    Dim targetParentFolder As String    ' 创建文件系统对象    Set fso = CreateObject("Scripting.FileSystemObject")    ' 让用户选择源文件夹（包含要转换的doc和docx文件）    With Application.FileDialog(msoFileDialogFolderPicker)        .Title = "iReg小程序：选择包含.doc文件的文件夹"        If .Show <> -1 Then Exit Sub ' 用户取消了操作        sourceFolder = .SelectedItems(1)    End With    ' 在源文件夹的同级目录创建目标总文件夹（如果不存在）    targetParentFolder = sourceFolder & "_ConvertedPDF"    If Not fso.FolderExists(targetParentFolder) Then        fso.CreateFolder targetParentFolder    End If    ' 开始递归转换    ConvertDocsInFolder fso, sourceFolder, targetParentFolder    ' 完成提示    MsgBox "iReg小程序：转换完成，转换后的文件保存在：" & vbCrLf & targetParentFolderEnd SubSub ConvertDocsInFolder(fso As Object, currentFolderPath As String, currentTargetParent As String)    ' 变量定义    Dim folder As Object    Dim subFolder As Object    Dim file As Object    Dim docFile As Object    Dim targetFilePath As String    Dim doc As Document    ' 获取当前文件夹对象    Set folder = fso.GetFolder(currentFolderPath)    ' 在当前文件夹对应的目标父目录下，创建相同的子文件夹结构    Dim relativePath As String    relativePath = Mid(currentFolderPath, Len(fso.GetParentFolderName(currentTargetParent)) + 2)    Dim targetFolderPath As String    targetFolderPath = fso.BuildPath(currentTargetParent, relativePath)    If Not fso.FolderExists(targetFolderPath) Then        fso.CreateFolder targetFolderPath    End If    ' 遍历当前文件夹中的所有文件    For Each file In folder.Files        ' 检查文件扩展名是否为doc或docx（不区分大小写）        If LCase(fso.GetExtensionName(file.Name)) Like "doc*" Then            ' 构建目标文件路径（将扩展名改为.docx）            targetFilePath = fso.BuildPath(targetFolderPath, fso.GetBaseName(file.Name) & ".pdf")            ' 转换文件            On Error Resume Next ' 错误处理，如文件损坏或正在被使用则跳过            Set doc = Documents.Open(file.Path, False, True, False) ' 以只读方式打开，避免锁定原文件            '转换为PDF之前锁定所有域            For Each fieldLoop In doc.Fields                fieldLoop.Locked = True            Next fieldLoop            If Not doc Is Nothing Then                ' 使用ExportAsFixedFormat2方法将Word转为PDF                doc.ExportAsFixedFormat2 _                    OutputFileName:=targetFilePath, _                    ExportFormat:=wdExportFormatPDF, _                    CreateBookmarks:=wdExportCreateHeadingBookmarks                doc.Close SaveChanges:=False            End If            On Error GoTo 0 ' 恢复错误处理        End If    Next file    ' 递归处理所有子文件夹    For Each subFolder In folder.SubFolders        ConvertDocsInFolder fso, subFolder.Path, currentTargetParent    Next subFolderEnd Sub