VBSCRIPT PPT转换脚本 [英] VBSCRIPT PPT conversion script

问题描述

我正在尝试使用 VBSCRIPT 将 PPT 文件转换为 PPTX 文件.我已经很长时间没有使用 VB 了 &我对框架很陌生.我正在尝试修改将 PPTX/PPT 转换为 PDF 的脚本，但运气不佳.这是我到目前为止所得到的一个例子......

I'm attempting to convert PPT files to PPTX files using VBSCRIPT. I haven't used VB in a very long time & am pretty unfamiliar with the framework. I'm attempting to modify a script that converts PPTX/PPT to PDF, however without much luck. Here's an example of what I've got so far...

Option Explicit

Dim inputFile
Dim objPPT
Dim objPresentation
Dim objPrintOptions
Dim objFso
Dim pptf

If WScript.Arguments.Count <> 1 Then
    WriteLine "You need to specify input and output files."
    WScript.Quit
End If

inputFile = WScript.Arguments(0)

Set objFso = CreateObject("Scripting.FileSystemObject")

If Not objFso.FileExists( inputFile ) Then
    WriteLine "Unable to find your input file " & inputFile
    WScript.Quit
End If



WriteLine "Input File:  " & inputFile

Set objPPT = CreateObject( "PowerPoint.Application" )

objPPT.Visible = True
objPPT.Presentations.Open inputFile

Set objPresentation = objPPT.ActivePresentation
objPresentation.SaveAs "out.pptx", Microsoft.Office.Interop.PowerPoint.PpSaveAsFileType.ppSaveAsOpenXMLPresentation

objPresentation.Close
ObjPPT.Quit

对象在 objPresentation.SaveAs 线周围变成梨形；显然它的语法是非法的 - 但是我不确定这里的最佳路线.任何帮助将非常感激.此外，如果有用于转换 doc->docx 和 xls->xlsx 的其他变量(或 api 文档的链接).提前致谢.

Things turn pear shaped around the objPresentation.SaveAs line; obviously its illegal syntax - however I'm not sure of the best route here. Any help would be much appreciated. Also if there are other variables (or a link to api documentation) for converting doc->docx, and xls->xlsx. Thanks in advance.

我自己找到了解决方案；抱歉，我在发布后几天就停止查看此线程.我找到了此代码的文档页面 &特别注意到一个功能 (convert2):http://msdn.microsoft.com/en-us/library/office/ff743830.aspx

I found a solution to this myself; sorry I stopped checking in on this thread a few days after posted it. I found a documentation page for this code & noticed one function in particular (convert2): http://msdn.microsoft.com/en-us/library/office/ff743830.aspx

我会将下面的答案标记为答案；因为它是最先出现的(虽然我还没有测试过).如果你有兴趣 - 这是我的代码；AFAIK 它只能在各种 PowerPoint 格式之间转换(在任一方向).另外仅供参考，我从另一个关于该主题的流行谷歌搜索脚本修改了这个脚本；我改变的唯一一行是最后一行(convert2 mehtod).无论如何......(还有 - 这需要 office 2010；根据文档)

I'll mark the answer below as the answer; because it came first (although I haven't tested it). If you're interested - heres my code; AFAIK it only converts in between various PowerPoint formats (in either direction). Also FYI I modified this script from another popularly googlized script on the topic; the only line I changed was one of the last (the convert2 mehtod). Anyways... (also - this requires office 2010; per the documentation)

用法:CSCRIPT scriptName.vbs C:\inputfileName.ppt C:\outputFileName.pptx

Usage: CSCRIPT scriptName.vbs C:\inputfileName.ppt C:\outputFileName.pptx

Option Explicit

Sub WriteLine ( strLine )
    WScript.Stdout.WriteLine strLine
End Sub

' http://msdn.microsoft.com/en-us/library/office/aa432714(v=office.12).aspx
Const msoFalse = 0   ' False.
Const msoTrue = -1   ' True.

' http://msdn.microsoft.com/en-us/library/office/bb265636(v=office.12).aspx
Const ppFixedFormatIntentScreen = 1 ' Intent is to view exported file on screen.
Const ppFixedFormatIntentPrint = 2  ' Intent is to print exported file.

' http://msdn.microsoft.com/en-us/library/office/ff746754.aspx
Const ppFixedFormatTypeXPS = 1  ' XPS format
Const ppFixedFormatTypePDF = 2  ' PDF format

' http://msdn.microsoft.com/en-us/library/office/ff744564.aspx
Const ppPrintHandoutVerticalFirst = 1   ' Slides are ordered vertically, with the first slide in the upper-left corner and the second slide below it.
Const ppPrintHandoutHorizontalFirst = 2 ' Slides are ordered horizontally, with the first slide in the upper-left corner and the second slide to the right of it.

' http://msdn.microsoft.com/en-us/library/office/ff744185.aspx
Const ppPrintOutputSlides = 1               ' Slides
Const ppPrintOutputTwoSlideHandouts = 2     ' Two Slide Handouts
Const ppPrintOutputThreeSlideHandouts = 3   ' Three Slide Handouts
Const ppPrintOutputSixSlideHandouts = 4     ' Six Slide Handouts
Const ppPrintOutputNotesPages = 5           ' Notes Pages
Const ppPrintOutputOutline = 6              ' Outline
Const ppPrintOutputBuildSlides = 7          ' Build Slides
Const ppPrintOutputFourSlideHandouts = 8    ' Four Slide Handouts
Const ppPrintOutputNineSlideHandouts = 9    ' Nine Slide Handouts
Const ppPrintOutputOneSlideHandouts = 10    ' Single Slide Handouts

' http://msdn.microsoft.com/en-us/library/office/ff745585.aspx
Const ppPrintAll = 1            ' Print all slides in the presentation.
Const ppPrintSelection = 2      ' Print a selection of slides.
Const ppPrintCurrent = 3        ' Print the current slide from the presentation.
Const ppPrintSlideRange = 4     ' Print a range of slides.
Const ppPrintNamedSlideShow = 5 ' Print a named slideshow.

' http://msdn.microsoft.com/en-us/library/office/ff744228.aspx
Const ppShowAll = 1             ' Show all.
Const ppShowNamedSlideShow = 3  ' Show named slideshow.
Const ppShowSlideRange = 2      ' Show slide range.

'
' This is the actual script
'

Dim inputFile
Dim outputFile
Dim objPPT
Dim objPresentation
Dim objPrintOptions
Dim objFso

If WScript.Arguments.Count <> 2 Then
    WriteLine "You need to specify input and output files."
    WScript.Quit
End If

inputFile = WScript.Arguments(0)
outputFile = WScript.Arguments(1)

Set objFso = CreateObject("Scripting.FileSystemObject")

If Not objFso.FileExists( inputFile ) Then
    WriteLine "Unable to find your input file " & inputFile
    WScript.Quit
End If

If objFso.FileExists( outputFile ) Then
    WriteLine "Your output file (' & outputFile & ') already exists!"
    WScript.Quit
End If

WriteLine "Input File:  " & inputFile
WriteLine "Output File: " & outputFile

Set objPPT = CreateObject( "PowerPoint.Application" )

objPPT.Visible = True
objPPT.Presentations.Open inputFile

Set objPresentation = objPPT.ActivePresentation
Set objPrintOptions = objPresentation.PrintOptions

objPrintOptions.Ranges.Add 1,objPresentation.Slides.Count
objPrintOptions.RangeType = ppShowAll

' Reference for this at http://msdn.microsoft.com/en-us/library/office/ff746080.aspx
objPresentation.convert2(output)

objPresentation.Close
ObjPPT.Quit

推荐答案

通常您会在 PowerPoint 中使用 ExportAsFixedFormat(...) 执行此操作.由于您选择了 VBS，您必须使用 SaveAs(...).

Normally you would do this in PowerPoint with ExportAsFixedFormat(...). Since you chose VBS, you have to use SaveAs(...).

我假设您还希望能够将 ppt/pptx 批量转换为 pdf，而不是一一指定完整的文件名...

I assume you would also want to be able to batch convert ppt/pptx into pdf rather than specify a full file name one by one...

Option Explicit

'http://msdn.microsoft.com/en-us/library/office/bb251061(v=office.12).aspx
Const ppSaveAsPDF = 32

Dim oFSO ' Public reference to FileSystemObject
Dim oPPT ' Public reference to PowerPoint App

Main

Sub Main()
    Dim sInput

    If wscript.Arguments.Count <> 1 Then
        Wscript.Echo "You need to specify input and output files."
        wscript.Quit
    End If

    ' PowerPoint version must be 12 or later (PowerPoint 2007 or later)
    Set oPPT = CreateObject("PowerPoint.Application")
    If CDbl(oPPT.Version) < 12 Then
        Wscript.Echo "PowerPoint version must be 2007 or later!"
        oPPT.Visible = True
        oPPT.Quit
        Set oPPT = Nothing
        wscript.Quit
    End If
    ' Store Input Argument and detect execute mode (single file / Folder batch mode)
    sInput = wscript.Arguments(0)
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    If IsPptFile(sInput) Then
        PPT2PDF sInput
    ElseIf oFSO.FolderExists(sInput) Then
        Wscript.Echo "Batch Start: " & Now
        Wscript.Echo "Root Folder: " & sInput
        BatchPPT2PDF sInput
    Else
        Wscript.Echo """" & sInput & """ is not a PPT file or Folder!"
    End If
    ' Close PowerPoint app if no other presentations are opened
    If oPPT.Presentations.Count = 0 Then oPPT.Quit
    Set oPPT = Nothing
    Set oFSO = Nothing
End Sub

Private Sub BatchPPT2PDF(sFDR)
    Dim oFDR, oFile
    Wscript.Echo String(50, Chr(151))
    Wscript.Echo "Processing Folder: " & sFDR
    For Each oFile In oFSO.GetFolder(sFDR).Files
        If IsPptFile(oFile.Name) Then
            PPT2PDF(oFile)
        End If
    Next
    For Each oFDR In oFSO.GetFolder(sFDR).SubFolders
        BatchPPT2PDF oFDR
    Next
End Sub

Private Function IsPptFile(sFile)
    IsPptFile = (InStr(1, Right(sFile, InStrRev(sFile, ".")), "ppt") > 0)
End Function

Private Sub PPT2PDF(sFile)
    On Error Resume Next
    Dim sPDF, oPres
    sPDF = Left(sFile,InstrRev(sFile,".")) & "pdf"
    Set oPres = oPPT.Presentations.Open(sFile, True, False, False) ' Read Only, No Title, No Window
    Err.Clear
    oPres.SaveAs sPDF, ppSaveAsPDF
    oPres.Close
    Set oPres = Nothing
    If Err.Number = 0 Then
        Wscript.Echo "OK" & vbTab & sPDF
    Else
        Wscript.Echo "X" & vbTab & sPDF & " [ERR " & Err.Number & ": " & Err.Description & "]"
        Err.Clear
    End If
End Sub

这篇关于VBSCRIPT PPT转换脚本的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！