Word批量转PDF，宏批量转PDF

Word批量转PDF，很多第三方工具都可以轻松实现，一般需要付费，这里，为大家提供一个VBA实现的方法，word原生功能。

在word中使用使用宏VBA，实现批量转PDF：

1、在Word中，打开你需要处理的doc文档；

2、按住键盘ALT+F11，调出VBA窗口;

3、在出现的VBA窗口中，粘贴批量转PDF代码，完整VB代码在文末；

 

补充：没有任何宏，只看到灰色一片，需要在左边的工程里面“Normal”，展开后的“模块”节点下，鼠标右键，选择“插入-模块”，然后将代码复制进去即可。

4、把键盘光标放到任意一行代码上，按键盘F5运行；

6、运行过程中，需要选择待转PDF的word文件夹，选择导出格式 1 （带word标题）后，等待导出即可。

7、切换回doc文档窗口看效果，如报错找不到文档请忽略。

8、执行完成后，word目录下将生产.PDF文档。

第一次比较麻烦，创建之后，再使用时，可以直接搜宏，调出此命令进行批量导出。

 

完整VB代码:

Rem 这里是主程序，会对主文件夹及其各级文件夹下所有Word文件执行导出操作
    '可以先把要操作的文件整理有一个文件夹下，以免有多余文件导出
Sub 批量导出PDF主程序()
    Dim fd As FileDialog
    Dim fso As Object
    Dim arr() '存储每次遍历到的文件夹的子文件夹
    Dim brr() '临时存储每次遍历到的文件夹的子文件夹
    Dim crr() '存储所有文件夹
    Dim drr() '存储所有Word文件路径
    Dim myFolder As Object
    Dim subFolder As Variant
    Dim i As Long
    Dim j As Long
    Dim m As Long
    Dim myFile As Object
    Dim 后缀 As String
    Dim t0 As Single
    Dim 书签类型 As Long

    t0 = Timer
    i = 0: j = 0: m = 0
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    Set fso = CreateObject("Scripting.FileSystemObject")

    With fd
        .Title = "选择主文件夹"
        If .Show Then
            i = i + 1
            ReDim Preserve crr(1 To i)
            crr(i) = .SelectedItems(1)
            arr = crr

            书签类型 = CLng(Trim(InputBox("请输入书签类型：" & vbCrLf & "0--不创建书签" _
                & vbCrLf & "1--根据Word标题创建书签" & vbCrLf & "2--根据Word书签创建书签", "书签类型", 1)))
            Do While Not InStr("012", CStr(书签类型)) > 0
                Select Case MsgBox("输入不符合要求，请：" & vbCrLf & "重新输入（是）" & vbCrLf & "退出程序（否）：", vbInformation + vbYesNo, "错误提示")
                    Case vbYes
                        书签类型 = CLng(Trim(InputBox("请输入书签类型：" & vbCrLf & "0--不创建书签" _
                            & vbCrLf & "1--根据Word标题创建书签" & vbCrLf & "2--根据Word书签创建书签", "书签类型", 1)))
                    Case vbNo
                        Exit Sub
                End Select
            Loop

            On Error Resume Next
            Do While Err.Number = 0
                For j = LBound(arr) To UBound(arr)
                    Set myFolder = fso.GetFolder(arr(j))
                    If myFolder.subFolders.Count > 0 Then
                        For Each subFolder In myFolder.subFolders
                            i = i + 1
                            ReDim Preserve crr(1 To i)
                            crr(i) = subFolder.Path

                            m = m + 1
                            ReDim Preserve brr(1 To m)
                            brr(m) = subFolder.Path
                        Next
                    End If
                Next
                m = 0
                arr = brr
                Erase brr
            Loop
            On Error GoTo 0

            i = 0
            For j = LBound(crr) To UBound(crr)
'                Debug.Print j, crr(j)
                Set myFolder = fso.GetFolder(crr(j))
                For Each myFile In myFolder.Files
                    后缀 = fso.GetExtensionName(myFile.Path)
                    If 后缀 Like "doc*" And Not 后缀 Like "*~$*" Then
                        i = i + 1
                        ReDim Preserve drr(1 To i)
                        drr(i) = myFile.Path
                    End If
                Next
            Next

            For j = LBound(drr) To UBound(drr)
                Rem 此处以下为调用的处理过程

                Application.ScreenUpdating = False
                Call 导出PDF_创建书签(drr(j), 书签类型)
                Application.ScreenUpdating = True

                Rem 此处以上为调用的处理过程
                Debug.Print Format(j, String(Len(CStr(UBound(drr))), "0")), drr(j), "导出完成"
            Next
        End If
    End With

    Set fd = Nothing
    Set fso = Nothing
    Set myFolder = Nothing
    On Error Resume Next
    Debug.Print "完成   共导出" & UBound(drr) & "个文件为PDF   用时" & Timer - t0 & "秒"
End Sub

Sub 导出PDF_创建书签(文件名, 书签类型 As Long)
    Dim aDoc As Document
    Dim fso As Object
    Dim 文件名1 As String

    Set aDoc = Documents.Open(文件名)
    Set fso = CreateObject("Scripting.FileSystemObject")

    文件名1 = fso.GetBaseName(文件名)
    aDoc.ExportAsFixedFormat2 outputfilename:=aDoc.Path & "\" & 文件名1 & ".PDF", _
        ExportFormat:=wdExportFormatPDF, CreateBookMarks:=书签类型

    aDoc.Close wdDoNotSaveChanges
    Set aDoc = Nothing
    Set fso = Nothing
End Sub