VBA批量移除Excel文件密码时如何跳过并识别损坏文件

实现逻辑 #

针对你提出的两个需求，可通过VBA内置的错误捕获机制同时实现跳过损坏文件、记录损坏文件名称的效果：

• 开启错误忽略后尝试打开Excel文件，若打开过程中触发错误即可判定该文件为损坏/密码不匹配的异常文件
• 用变量存储所有异常文件的名称，全部文件处理完成后统一弹窗提示
• 错误状态每处理完一个文件就重置，不影响后续文件的判断

修改后完整代码 #

Sub 批量移除Excel密码()
    Dim xlBook As Workbook
    Dim strFilename As String
    Dim 错误文件列表 As String ' 存储损坏/无法打开的文件名
    Const 目标文件夹 As String = "C:\Path\" ' 处理的文件夹路径，末尾必须带"\"
    Const 打开密码 As String = "openpassword" ' 原文件打开密码，区分大小写
    Const 编辑密码 As String = "editpassword" ' 原文件编辑密码，无密码则填""
    
    strFilename = Dir$(目标文件夹 & "*.xls") ' 匹配xls/xlsx/xlsb等格式
    错误文件列表 = ""
    
    While Len(strFilename) <> 0
        Application.DisplayAlerts = False
        ' 开启错误捕获，遇到错误继续执行下一行
        On Error Resume Next
        Set xlBook = Workbooks.Open(FileName:=目标文件夹 & strFilename, _
                                    Password:=打开密码, _
                                    WriteResPassword:=编辑密码)
        ' 判断打开文件是否出错
        If Err.Number <> 0 Then
            ' 出错则记录文件名，跳过后续保存操作
            错误文件列表 = 错误文件列表 & vbCrLf & strFilename
            Err.Clear ' 清空错误状态
        Else
            ' 正常打开则移除密码保存
            xlBook.SaveAs FileName:=目标文件夹 & strFilename, _
                          Password:="", _
                          WriteResPassword:="", _
                          CreateBackup:=True
            xlBook.Close 0
        End If
        On Error GoTo 0 ' 关闭错误捕获，避免隐藏其他非预期错误
        Application.DisplayAlerts = True
        strFilename = Dir$()
    Wend
    
    ' 处理完成后提示结果
    If 错误文件列表 = "" Then
        MsgBox "全部文件处理完成，无异常文件！", vbInformation
    Else
        MsgBox "处理完成，以下文件为损坏/无法打开的异常文件：" & vbCrLf & 错误文件列表, vbExclamation
    End If
End Sub

代码使用说明 #

• 请提前修改代码里的目标文件夹、打开密码、编辑密码三个常量为你实际的参数
• 运行后会自动跳过所有无法正常打开的损坏文件，全部处理完成后弹窗会列出所有异常文件的名称，方便你后续单独处理

内容的提问来源于stack exchange，提问作者Franco Onorati