文章介绍了如何利用Word的VBA宏功能批量将Word文档转换为PDF格式。用户需要打开文档，调出VBA窗口，插入并运行提供的VB代码，选择目标文件夹，然后程序会自动将该文件夹及子文件夹下的所有Word文档转换为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.FileDia
log(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
扫一扫
1269
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
