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