VBScript 导出 ppt/pptx 到 WMV

VBScript export ppt/pptx to WMV

我是 VBScript 的新手,我有一个小任务:以 "background" 模式将 ppt/pptx 文件导出到视频 (WMV)。我在 Internet 上搜索,现在我有这个脚本:

'''
On Error Resume Next
Dim oPowerPointApp
Set oPowerPointApp = CreateObject("PowerPoint.Application")
If Err.Number = 0 Then
   oPowerPointApp.DisplayAlerts = ppAlertsNone
   Dim oPresentation
   Set oPresentation = oPowerPointApp.Presentations.Open("D:\TestPresentation.pptx", msoTrue, , msoFalse)
   If Err.Number = 0 Then
      ' True - use the existing transitions, 5 sec per slide by default, 720 - height of the video, 30 - fps, 85 - quality[1;100]
      oPresentation.CreateVideo "D:\TestPresentation.wmv", True, 5, 720, 30, 85
      ' Now wait for the conversion to be complete:
      Do
         ' Don't tie up the user interface; add DoEvents to give the mouse and keyboard time to keep up.
         DoEvents
         Select Case oPresentation.CreateVideoStatus
            Case PpMediaTaskStatus.ppMediaTaskStatusDone
               WScript.Echo "Conversion complete!"
               Err.Number = 0
               Exit Do
            Case PpMediaTaskStatus.ppMediaTaskStatusFailed
               WScript.Echo "Conversion failed!"
               Err.Number = 1
               Exit Do
            Case PpMediaTaskStatus.ppMediaTaskStatusInProgress
               WScript.Echo "Conversion in progress" ' For Debug only
            Case PpMediaTaskStatus.ppMediaTaskStatusNone
               ' You'll get this value when you ask for the status and no conversion is happening or has completed.
            Case PpMediaTaskStatus.ppMediaTaskStatusQueued
               WScript.Echo "Conversion queued" ' For Debug only
         End Select
         'WScript.Sleep 200
      Loop
      'WScript.Sleep 5000
      oPresentation.Close
   End If
   oPowerPointApp.Quit
End If
WScript.Echo Err.Number
'''

大部分情况下它工作正常。输出消息是 "Conversion complete!"。但是有一个弹出的是-否对话框:"This presentation is currently being exported to video. Closing this presentation will abort pending exports of this presentation. Do you want to close anyway?"。现在我需要避免显示此对话框。我尝试使用睡眠延迟,但没有用。是否可以避免此对话框?我这边用的是PowerPoint 2016。谢谢

如果您关闭 On Error Resume Next,您将在未声明的 PpMediaTaskStatus 上看到运行时错误,即在此处声明它或使用其数值

Do
  Select Case oPresentation.CreateVideoStatus
  Case 3 'PpMediaTaskStatus.ppMediaTaskStatusDone
    WScript.Echo "Conversion complete!"
    Err.Number = 0
    Exit Do
  Case 4 'PpMediaTaskStatus.ppMediaTaskStatusFailed
    WScript.Echo "Conversion failed!"
    Err.Number = 1
    Exit Do
  End Select
  WScript.Sleep 200 'it's in ms, so makes sense to set 1000 (1 sec)
Loop