ppt word快速转换PDF小脚本

这个vbs小脚本可以快速将同一目录下的ppt、pptx、doc、docx文件转换成PDF，即点即用，非常方便。

Office （ ppt word快速转换PDF-Office.vbs ）

On Error Resume Next
MsgBox "Start converting PPT and Word files into PDF format. Please ensure Office or WPS is installed. Please wait...", vbInformation, "Conversion Start"

Const wdExportFormatPDF = 17
Dim oWord, ppt, fso, isOffice, isWPS

' 初始化变量
Set fso = WScript.CreateObject("Scripting.Filesystemobject")
isOffice = False
isWPS = False

Set oWord = WScript.CreateObject("KWPS.Application")
Set ppt = CreateObject("KWPP.application")
If IsObject(oWord) And IsObject(ppt) Then
    isOffice = True
Else
    If IsObject(oWord) Then oWord.Quit
    If IsObject(ppt) Then ppt.Quit
    Set oWord = Nothing
    Set ppt = Nothing
    
    Set oWord = WScript.CreateObject("Word.Application")
    Set ppt = CreateObject("PowerPoint.application")
    If IsObject(oWord) And IsObject(ppt) Then
        isWPS = True
    Else
        ' 两种办公软件都未安装
        If IsObject(oWord) Then oWord.Quit
        If IsObject(ppt) Then ppt.Quit
        Set oWord = Nothing
        Set ppt = Nothing
        Set fso = Nothing
        MsgBox "Failed to find Office or WPS. Please install one of them first.", vbCritical, "Error"
        WScript.Quit
    End If
End If

' 开始处理文件夹
ProcessFolder fso.GetFolder(".")

' 清理对象
If IsObject(oWord) Then
    oWord.Quit
    Set oWord = Nothing
End If
If IsObject(ppt) Then
    ppt.Quit
    Set ppt = Nothing
End If
Set fso = Nothing

MsgBox "PPT and Word files have been successfully converted into PDF format!", vbInformation, "Conversion Complete"

Sub ProcessFolder(folder)
    Dim ff, subFolder, pdfPath
    
    For Each ff In folder.Files
        ' 处理Word文件 (.doc, .docx) 且不是临时文件
        If (LCase(Right(ff.Name, 4)) = ".doc" Or LCase(Right(ff.Name, 5)) = ".docx") And Left(ff.Name, 1) <> "~" Then
            pdfPath = Left(ff.Path, InStrRev(ff.Path, ".")) & "pdf"
            Set oDoc = oWord.Documents.Open(ff.Path)
            oDoc.ExportAsFixedFormat pdfPath, wdExportFormatPDF
            oDoc.Close
            Set oDoc = Nothing
        End If
        
        ' 处理PowerPoint文件 (.ppt, .pptx) 且不是临时文件
        If (LCase(Right(ff.Name, 4)) = ".ppt" Or LCase(Right(ff.Name, 5)) = ".pptx") And Left(ff.Name, 1) <> "~" Then
            pdfPath = Left(ff.Path, InStrRev(ff.Path, ".")) & "pdf"
            Set pptfile = ppt.Presentations.Open(ff.Path, False, False, False)
            pptfile.SaveAs pdfPath, 32, False
            pptfile.Close
            Set pptfile = Nothing
        End If
    Next
    
    ' 递归处理子文件夹
    For Each subFolder In folder.SubFolders
        ProcessFolder subFolder
    Next
End Sub

WPS ( ppt word快速转换PDF-WPS.vbs )

On Error Resume Next
    MsgBox "开始转换PPT和Word文件为PDF格式，请稍候..."
    Const wdExportFormatPDF = 17
    Set oWord = WScript.CreateObject("KWPS.Application")
	Set ppt = CreateObject("KWPP.application")
    Set fso = WScript.CreateObject("Scripting.Filesystemobject")
    Set fds=fso.GetFolder(".")
    Set ffs=fds.Files
	
    For Each ff In ffs
    If (LCase(Right(ff.Name,4))=".doc" Or LCase(Right(ff.Name,4))="docx" ) And Left(ff.Name,1)<>"~" Then
        Set oDoc=oWord.Documents.Open(ff.Path)
        oDoc.ExportAsFixedFormat Left(ff.Path,InStrRev(ff.Path,"."))&"pdf",wdExportFormatPDF
        oDoc.Close

    End If
	If (LCase(Right(ff.Name,4))=".ppt" Or LCase(Right(ff.Name,4))="pptx" ) And Left(ff.Name,1)<>"~" Then
        Set pptfile = ppt.Presentations.Open(ff.Path,false,false,false)
        pptfile.Saveas Left(ff.Path,InStrRev(ff.Path,"."))&"pdf",32,false
		pptfile.Close
    End If
    Next
    odoc.Close
    oword.Quit
	pptfile.Close
	ppt.Quit
    Set oDoc=Nothing
    Set oWord =Nothing
	Set pptfile = Nothing
	Set ppt = Nothing
	MsgBox "PPT和Word文件已成功转换为PDF格式！"

合并 （ppt word快速转换PDF-合并.vbs）

On Error Resume Next
MsgBox "开始转换PPT和Word文件为PDF格式，请稍候..."
Const wdExportFormatPDF = 17
Dim oWord, ppt, isWPS, isOffice

' 尝试创建WPS对象
Set oWord = WScript.CreateObject("KWPS.Application")
Set ppt = CreateObject("KWPP.Application")

' 检测是否是WPS环境
If Not oWord Is Nothing And Not ppt Is Nothing Then
    isWPS = True
Else
    ' 尝试创建Office对象
    Set oWord = WScript.CreateObject("Word.Application")
    Set ppt = CreateObject("PowerPoint.Application")
    If Not oWord Is Nothing And Not ppt Is Nothing Then
        isOffice = True
    Else
        MsgBox "未检测到WPS或Office，请确保已安装其中一款办公软件！"
        WScript.Quit
    End If
End If

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set fds = fso.GetFolder(".")
Set ffs = fds.Files

For Each ff In ffs
    ' 处理Word文件
    If (LCase(Right(ff.Name, 4)) = ".doc" Or LCase(Right(ff.Name, 4)) = "docx") And Left(ff.Name, 1) <> "~" Then
        Set oDoc = oWord.Documents.Open(ff.Path)
        oDoc.ExportAsFixedFormat Left(ff.Path, InStrRev(ff.Path, ".")) & "pdf", wdExportFormatPDF
        oDoc.Close
        Set oDoc = Nothing
    End If
    
    ' 处理PPT文件
    If (LCase(Right(ff.Name, 4)) = ".ppt" Or LCase(Right(ff.Name, 4)) = "pptx") And Left(ff.Name, 1) <> "~" Then
        Set pptfile = ppt.Presentations.Open(ff.Path, False, False, False)
        pptfile.SaveAs Left(ff.Path, InStrRev(ff.Path, ".")) & "pdf", 32, False
        pptfile.Close
        Set pptfile = Nothing
    End If
Next

' 清理对象
If Not oWord Is Nothing Then
    oWord.Quit
    Set oWord = Nothing
End If
If Not ppt Is Nothing Then
    ppt.Quit
    Set ppt = Nothing
End If

MsgBox "PPT和Word文件已成功转换为PDF格式！"