等待PowerPoint导出为MP4完成

Question

我使用VBA将PowerPoint演示文稿保存为mp4文件。我想在保存操作完成后关闭它。

我不知道如何确定此操作何时完成。

ActivePresentation.SaveAs outFile, 39
Do  while  ????
ActivePresentation.close
Loop

我目前使用的解决方案是wscript.sleep，但这不是一个好主意。因为不同大小的ppt需要不同的时间

ActivePresentation.SaveAs outFile, pptFormat
' save as MP4 need long time, do not close too early
If StrComp(Ucase( outFormat ),"MP4") = 0 then
wscript.sleep 1000*60
End If
' Close the active document
ActivePresentation.Close

下面是我的使用代码

Option Explicit

'PPT2ANY "PATH_TO_INFILENEOHOPE.COM.IN.pptx","PATH_TO_INFILENEOHOPE.COM.OUT.pdf","PDF"
'PPT2ANY "PATH_TO_INFILENEOHOPE.COM.IN.pptx","PATH_TO_INFILENEOHOPE.COM.OUT.png","PNG"
PPT2ANY "D:videogenerateComplete1.pptx","D:videoonlyVideo1","MP4"
'Call PPT2ANY(WScript.Arguments(0),WScript.Arguments(1),WScript.Arguments(2))

Sub PPT2ANY( inFile, outFile, outFormat)
Dim objFSO, objPPT, objPresentation, pptFormat

Const ppSaveAsAddIn                             =8
Const ppSaveAsBMP                               =19
Const ppSaveAsDefault                           =11
Const ppSaveAsEMF                               =23
Const ppSaveAsExternalConverter                 =64000
Const ppSaveAsGIF                               =16
Const ppSaveAsJPG                               =17
Const ppSaveAsMetaFile                          =15
Const ppSaveAsMP4                               =39
Const ppSaveAsOpenDocumentPresentation          =35
Const ppSaveAsOpenXMLAddin                      =30
Const ppSaveAsOpenXMLPicturePresentation        =36
Const ppSaveAsOpenXMLPresentation               =24
Const ppSaveAsOpenXMLPresentationMacroEnabled   =25
Const ppSaveAsOpenXMLShow                       =28
Const ppSaveAsOpenXMLShowMacroEnabled           =29
Const ppSaveAsOpenXMLTemplate                   =26
Const ppSaveAsOpenXMLTemplateMacroEnabled       =27
Const ppSaveAsOpenXMLTheme                      =31
Const ppSaveAsPDF                               =32
Const ppSaveAsPNG                               =18
Const ppSaveAsPresentation                      =1
Const ppSaveAsRTF                               =6
Const ppSaveAsShow                              =7
Const ppSaveAsStrictOpenXMLPresentation         =38
Const ppSaveAsTemplate                          =5
Const ppSaveAsTIF                               =21
Const ppSaveAsWMV                               =37
Const ppSaveAsXMLPresentation                   =34
Const ppSaveAsXPS                               =33

' Create a File System object
Set objFSO = CreateObject( "Scripting.FileSystemObject" )

' Create a PowerPoint object
Set objPPT = CreateObject( "PowerPoint.Application" )

With objPPT
' True: make PowerPoint visible; False: invisible
.Visible = True

' Check if the PowerPoint document exists
If not( objFSO.FileExists( inFile ) ) Then
WScript.Echo "FILE OPEN ERROR: The file does not exist" & vbCrLf
' Close PowerPoint
.Quit
Exit Sub
End If

' Open the PowerPoint document
.Presentations.Open inFile

' Make the opened file the active document
Set objPresentation = .ActivePresentation

If StrComp(Ucase( outFormat ),"PDF") = 0 then
pptFormat = ppSaveAsPDF 
ElseIf StrComp(Ucase( outFormat ),"XPS") = 0 then
pptFormat = ppSaveAsXPS
ElseIf StrComp(Ucase( outFormat ),"BMP") = 0 then
pptFormat= ppSaveAsBMP
ElseIf StrComp(Ucase( outFormat ),"PNG") = 0 then
pptFormat= ppSaveAsPNG
ElseIf StrComp(Ucase( outFormat ),"JPG") = 0 then
pptFormat= ppSaveAsJPG
ElseIf StrComp(Ucase( outFormat ),"GIF") = 0 then
pptFormat= ppSaveAsGIF
ElseIf StrComp(Ucase( outFormat ),"XML") = 0 then
pptFormat= ppSaveAsOpenXMLPresentation
ElseIf StrComp(Ucase( outFormat ),"RTF") = 0 then
pptFormat= ppSaveAsRTF
ElseIf StrComp(Ucase( outFormat ),"MP4") = 0 then
pptFormat= ppSaveAsMP4
Else
WScript.Echo "FILE FORTMART ERROR: Unknown file format" & vbCrLf
' Close PowerPoint
.Quit
Exit Sub
End If

' Save in PDF/XPS format
objPresentation.SaveAs outFile, pptFormat
'objPresentation.CreateVideo  "D:videoonlyVideo.mp4", false
' save as MP4 need long time, do not close too early
If StrComp(Ucase( outFormat ),"MP4") = 0 then
wscript.sleep 1000*50
End If
' Close the active document
objPresentation.Close

' Close PowerPoint
.Quit
End With
End Sub

Answer 1

我不认为savea会返回，直到它完成保存文件。我希望这段代码能像你想的那样工作:

ActivePresentation.SaveAs outFile, ppSaveAsMP4
ActivePresentation.Close

Answer 2

我用下面的方法解决了我的问题

If StrComp(Ucase( outFormat ),"MP4") = 0 then
wscript.sleep 1000*1
outFilePath = outFile&".mp4"
If objFSO.FileExists( outFilePath ) Then 
Set f = objFSO.GetFile(outFilePath)            
do until f.size > 0
wscript.sleep 1000*1
Loop
End If
End If

Answer 3

导出为视频需要另一个过程。savea立即将控制权返回到VBA，但视频导出仍在不同的过程中进行。

Shyam Pillai解释了如何处理这个问题:

http://skp.mvps.org/2010/ppt015.htm

简短的解释:在循环中轮询演示文稿的CreateVideoStatus属性，直到它返回Done或Failed代码。