PPT批量转PDF的VBA代码遗漏部分文件，求排查修复

问题根源分析 #

原代码存在4个核心问题，导致转换不稳定、文件随机遗漏：

• 全局On Error Resume Next屏蔽所有错误，失败文件无提示直接跳过，无法定位问题
• 依赖ActivePresentation获取当前文件，若打开时弹出提示（如宏警告）会改变激活状态，导致导出错误
• PDF导出为异步操作，未等待完成就关闭PPT，部分大文件会中断导出
• 文件名处理错误，生成的PDF会带上原PPT扩展名（如xxx.pptx.pdf）

修复后的完整代码 #

主过程：批量打开并转换PPT

Public Sub OpenPpts()
    Dim strFileName As String
    Dim strFolderName As String
    Dim PP As Presentation
    
    strFolderName = "C:\my ppt files\"
    ' 修正路径拼接，避免重复的反斜杠
    strFileName = Dir(strFolderName & "*.pptx")
    
    Do While Len(strFileName) > 0
        ' 临时捕获文件打开错误，避免整个循环中断
        On Error Resume Next
        ' 以只读模式打开，避免文件锁定
        Set PP = Presentations.Open(strFolderName & strFileName, msoFalse)
        On Error GoTo 0
        
        If Not PP Is Nothing Then
            ' 传入具体的演示文稿对象，替代不稳定的ActivePresentation
            Call CreatePdf(PP)
            ' 无需保存原PPT（除非你需要修改后保存），直接关闭
            PP.Close msoFalse
        Else
            ' 可选：弹出提示定位失败文件
            MsgBox "无法打开文件：" & strFileName
        End If
        
        strFileName = Dir
    Loop
End Sub

独立子过程：导出PDF（保持独立可复用）

Sub CreatePdf(targetPPT As Presentation)
    ' 生成正确的PDF文件名：移除原PPT扩展名，替换为.pdf
    Dim pdfPath As String
    pdfPath = Left(targetPPT.FullName, InStrRev(targetPPT.FullName, ".") - 1) & ".pdf"
    
    ' 同步导出PDF，明确参数确保完整性
    targetPPT.ExportAsFixedFormat _
        Path:=pdfPath, _
        FixedFormatType:=ppFixedFormatTypePDF, _
        Intent:=ppFixedFormatIntentPrint, _
        PrintRange:=ppPrintAll, _
        IncludeDocProperties:=msoTrue, _
        BitmapMissingFonts:=msoTrue
    
    ' 等待导出完成（针对大文件必备）
    DoEvents
End Sub

关键修改说明 #

1. 错误处理优化：移除全局错误屏蔽，仅在打开文件时临时捕获，同时添加错误提示，方便定位问题文件
2. 避免激活依赖：给CreatePdf添加targetPPT参数，直接传入目标演示文稿对象，彻底摆脱对ActivePresentation的依赖
3. 文件名修正：通过InStrRev定位扩展名位置，生成正确的PDF文件名格式
4. 同步导出保障：添加DoEvents等待导出完成，避免文件未导出就被关闭
5. 只读模式打开：避免文件被锁定，确保批量处理的连续性

内容的提问来源于stack exchange，提问作者Owen Johnson