ppt word快速转换PDF小脚本

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

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

On Error Resume Next
    MsgBox "开始转换PPT和Word文件为PDF格式，请稍候..."
    Const wdExportFormatPDF = 17
    Set oWord = WScript.CreateObject("Word.Application")
	Set ppt = CreateObject("PowerPoint.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格式！"

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格式！"