如何等待PowerPoint的SaveAs视频导出操作完成？

嗨，我完全懂你的困扰——处理大型PPT批量导出MP4时，PowerPoint的10个导出队列上限真的很闹心，固定等待时间又完全不靠谱，毕竟每张幻灯片的导出时长差得太多了。

首先得理清核心问题：PowerPoint用SaveAs导出MP4是异步操作，也就是说脚本执行到SaveAs这一行后，不会等导出完成就直接往下跑，这才导致队列很快被塞满。你说用Dir检测不行也很对，因为PowerPoint一开始导出就会创建文件，光检测文件存在根本判断不了是否导出完成。

那咱们换个思路——检测文件的大小是否停止变化：导出过程中文件大小会持续增长，直到导出完成后才会稳定下来，这个逻辑就很靠谱。下面是修改后的完整代码，已经加入了等待导出完成的逻辑：

Sub ExportSlidesToMP4()
    Dim BoxValue As Variant
    Dim NameValue As Integer
    Dim BoxMessage As String, BoxTitle As String
    Dim outputPath As String
    Dim fileSize As Long, prevFileSize As Long
    Dim waitStartTime As Double
    
    ' 输入起始幻灯片编号
    BoxTitle = "输入起始幻灯片编号"
    BoxMessage = "请输入要导出的第一张幻灯片的编号（示例：20）"
    BoxValue = InputBox(BoxMessage, BoxTitle, "20")
    
    ' 验证输入是否为有效数字
    If Not IsNumeric(BoxValue) Then
        MsgBox "请输入有效的数字！", vbExclamation
        Exit Sub
    End If
    BoxValue = CInt(BoxValue)
    
    ' 先隐藏所有幻灯片
    Dim i As Integer
    For i = 1 To ActivePresentation.Slides.Count
        ActivePresentation.Slides(i).SlideShowTransition.Hidden = True
    Next i
    
    ' 遍历每张幻灯片，逐个导出
    For i = 1 To ActivePresentation.Slides.Count
        ' 计算导出的文件名编号
        If BoxValue <> 1 Then
            If i = 1 Then
                NameValue = BoxValue
            Else
                NameValue = BoxValue + i - 1 ' 修正原逻辑的编号跳变问题
            End If
        Else
            NameValue = i
        End If
        
        outputPath = ActivePresentation.Path & "\s" & NameValue & ".mp4"
        
        ' 显示当前要导出的幻灯片
        ActivePresentation.Slides(i).SlideShowTransition.Hidden = False
        
        ' 触发导出操作
        ActivePresentation.SaveAs outputPath, ppSaveAsMP4
        
        ' 等待导出完成：检测文件大小是否稳定
        prevFileSize = 0
        waitStartTime = Timer ' 记录等待起始时间，防止无限等待
        Do
            DoEvents ' 让PowerPoint有时间处理导出任务
            If Dir(outputPath) <> "" Then
                fileSize = FileLen(outputPath)
                ' 当文件大小连续两次相同，且等待超过5秒时（避免初始阶段的短暂稳定）
                If fileSize = prevFileSize And (Timer - waitStartTime) > 5 Then
                    Exit Do
                End If
                prevFileSize = fileSize
            End If
            ' 超时保护：最多等待120秒，可根据你的PPT大小调整
            If Timer - waitStartTime > 120 Then
                MsgBox "导出幻灯片" & i & "超时，已跳过", vbWarning
                Exit Do
            End If
        Loop
        
        ' 隐藏当前幻灯片，准备下一张导出
        ActivePresentation.Slides(i).SlideShowTransition.Hidden = True
    Next i
    
    MsgBox "所有幻灯片导出完成！", vbInformation
End Sub

代码的关键改进点： #

• 修正了原代码的潜在问题：包括变量类型隐式声明（比如原代码Default默认是Variant类型）、文件名编号跳变的逻辑错误，现在规范了变量类型，导出的文件名会连续递增。
• 文件大小检测逻辑：通过循环监控文件大小变化，确保只有当导出真正完成（大小稳定）后，才会继续下一张幻灯片的导出，完美避开队列上限。
• 超时保护机制：加入了120秒的最大等待时间，防止因为异常情况导致脚本无限挂起，你可以根据自己的PPT大小调整这个数值。
• 输入验证：增加了对输入内容的合法性检查，避免无效输入导致的脚本报错。

另外还有一个备选方案是利用PowerPoint的ExportProgress事件，但需要把代码放在类模块中，相对复杂一些。上面的文件大小检测方法更简单直接，完全适配你的场景。

备注：内容来源于stack exchange，提问作者EBasset