vbs脚本实现word批量转为pdf（附代码）

vbs脚本实现word批量转为pdf

        创建一个.txt文档，复制代码到.txt文档中，修改文件后缀为.vbs，将脚本文件放在需要转换的父级文件夹中，双击运行，会在c:\newword中将word文件按原有目录结构转换为pdf文件。

        前提条件：电脑需有word。

Option Explicit

' 文件扩展名的常量
Const DOC_EXT = "doc"
Const DOCX_EXT = "docx"
Const PDF_EXT = ".pdf"

' PDF导出格式的常量
Const wdExportFormatPDF = 17

' 创建FileSystemObject
Dim fileSystem
Set fileSystem = WScript.CreateObject("Scripting.FileSystemObject")

' 获取当前文件夹
Dim currentFolder
Set currentFolder = fileSystem.GetFolder(".")

' 获取C盘的根目录
Dim cDriveFolder
Set cDriveFolder = fileSystem.GetFolder("C:\")

' 如果不存在，就在C盘创建一个名为newword的文件夹
Dim newWordFolder
If Not fileSystem.FolderExists(cDriveFolder.Path & "\newword") Then
    Set newWordFolder = fileSystem.CreateFolder(cDriveFolder.Path & "\newword")
Else
    Set newWordFolder = fileSystem.GetFolder(cDriveFolder.Path & "\newword")
End If

' 创建Word应用程序对象
Dim wordApp
Set wordApp = WScript.CreateObject("Word.Application")

' 把当前文件夹及其子文件夹中的Word文档转换成PDF文件，并复制到newword文件夹中
call ConvertAndCopyWordDocuments(currentFolder, newWordFolder, wordApp)

' 退出Word应用程序
wordApp.Quit

' 释放对象
Set wordApp = Nothing

' 完成时显示消息
' WScript.Echo "转换并复制Word文档完成！"

' 从一个源文件夹到一个目标文件夹递归地转换并复制Word文档的子程序
Sub ConvertAndCopyWordDocuments(sourceFolder, destFolder, wordApp)
MsgBox "转换完成，文件位于c:\newword"

    ' 遍历源文件夹中的文件
    Dim file, fileName, fileExt, destPath, doc
    For Each file In sourceFolder.Files
		
        ' 获取文件名和扩展名
        fileName = fileSystem.GetFileName(file.Name)
        fileExt = fileSystem.GetExtensionName(file.Name)

        ' 检查文件是否是Word文档，并且不是临时文件
        If (LCase(fileExt) = LCase(DOC_EXT) Or LCase(fileExt) = LCase(DOCX_EXT)) And _
            Left(fileName, 1) <> "~" Then
			
            ' 获取不带扩展名的文件名
            fileName = GetFileNameWithoutExtension(fileName)

            ' 获取PDF文件的目标路径
            destPath = destFolder.Path & "\" & fileName & PDF_EXT

            ' 打开文档
            Set doc = wordApp.Documents.Open(file.Path)

            ' 导出文档为PDF
            doc.ExportAsFixedFormat destPath, wdExportFormatPDF

            ' 处理错误
            If Err.Number Then
                WScript.Echo Err.Description
            End If

            ' 关闭文档
            doc.Close

        End If

    Next

    ' 遍历源文件夹中的子文件夹
    Dim subfolder, subDestFolder
    For Each subfolder In sourceFolder.SubFolders

        ' 如果不存在，就在目标文件夹中创建一个同名的子文件夹
        If Not fileSystem.FolderExists(destFolder.Path & "\" & subfolder.Name) Then
            Set subDestFolder = fileSystem.CreateFolder(destFolder.Path & "\" & subfolder.Name)
        Else
            Set subDestFolder = fileSystem.GetFolder(destFolder.Path & "\" & subfolder.Name)
        End If

        ' 递归地从子文件夹转换并复制Word文档到子目标文件夹
        ConvertAndCopyWordDocuments subfolder, subDestFolder, wordApp

    Next
		MsgBox "Word---->PDF To c:\newword 		Finish!"

End Sub

' 获取不带扩展名的文件名的函数
Function GetFileNameWithoutExtension(fileName)
    Dim dotPosition
    dotPosition = InStrRev(fileName, ".")
    If dotPosition > 0 Then
        GetFileNameWithoutExtension = Left(fileName, dotPosition - 1)
    Else
        GetFileNameWithoutExtension = fileName
    End If
End Function