如何用Excel VBA遍历目录加密XLS文件，尝试多密码解锁并去密码保存？

刚好做过类似的批量处理需求，用Excel VBA就能轻松搞定！我给你整理了完整的实现方案，包括代码和详细说明：

1. 遍历目标文件夹下所有.xls格式的文件
2. 对每个文件依次尝试预设的三个密码，用错误捕获机制跳过密码错误的情况
3. 成功解锁后，将文件保存为无密码版本（可选择覆盖原文件或保留原文件存到新目录）

Sub BatchRemoveXlsPasswords()
    Dim targetFolder As String
    Dim currentFile As String
    Dim targetWorkbook As Workbook
    Dim passwordList As Variant
    Dim pwd As Variant
    Dim outputFolder As String
    
    ' --------------------------
    ' 请修改这里的路径配置
    ' --------------------------
    targetFolder = "C:\Your\Source\Folder\" ' 存放加密xls文件的目录
    outputFolder = targetFolder & "Unprotected_Files\" ' 无密码文件的保存目录（建议单独存，避免覆盖原文件）
    ' 如果想要直接覆盖原文件，把上面一行改成：outputFolder = targetFolder
    
    ' 预设的密码列表，可根据需要增减
    passwordList = Array("123", "456", "789")
    
    ' 创建输出目录（如果不存在的话）
    If Dir(outputFolder, vbDirectory) = "" Then
        MkDir outputFolder
    End If
    
    ' 开始遍历目录下的xls文件
    currentFile = Dir(targetFolder & "*.xls")
    Do While currentFile <> ""
        Set targetWorkbook = Nothing
        
        ' 依次尝试每个密码
        For Each pwd In passwordList
            On Error Resume Next ' 开启错误捕获，忽略密码错误导致的弹窗
            Set targetWorkbook = Application.Workbooks.Open( _
                Filename:=targetFolder & currentFile, _
                Password:=pwd, _
                ReadOnly:=False) ' 必须设为False才能保存修改
            On Error GoTo 0 ' 关闭错误捕获
            
            ' 如果成功打开文件，跳出密码循环
            If Not targetWorkbook Is Nothing Then
                Debug.Print "✅ 成功解锁：" & currentFile
                Exit For
            End If
        Next pwd
        
        ' 处理成功解锁的文件
        If Not targetWorkbook Is Nothing Then
            ' 保存为无密码文件
            targetWorkbook.SaveAs _
                Filename:=outputFolder & currentFile, _
                FileFormat:=xlExcel8, ' xls格式对应的文件格式代码
                Password:="" ' 空密码表示移除保护
            
            targetWorkbook.Close SaveChanges:=False ' 已经SaveAs完成，无需再保存
        Else
            ' 所有密码都尝试失败的情况
            Debug.Print "❌ 无法解锁：" & currentFile & "（所有密码均无效）"
        End If
        
        ' 切换到下一个文件
        currentFile = Dir
    Loop
    
    MsgBox "批量处理完成！请按Ctrl+G打开即时窗口查看详细结果。"
End Sub

• 路径配置：targetFolder是你的加密文件所在目录，outputFolder建议设为单独的文件夹，避免误删原文件；如果确定要覆盖，直接把outputFolder设为和targetFolder一致即可。
• 密码列表：用Array()存储所有可能的密码，后续要添加新密码直接修改数组就行，比如Array("123", "456", "789", "abc")。
• 错误捕获：On Error Resume Next会跳过密码错误的弹窗，让代码自动尝试下一个密码；成功打开后targetWorkbook会被赋值，此时就可以停止尝试其他密码。
• 保存设置：FileFormat:=xlExcel8是专门针对.xls格式的参数，如果是.xlsx文件，要改成xlOpenXMLWorkbook（对应代码51）。

1. 打开Excel，按下Alt+F11打开VBA编辑器
2. 右键点击左侧的VBAProject，选择「插入」→「模块」
3. 将上面的代码粘贴到模块中，修改targetFolder和outputFolder为你的实际路径
4. 按下F5运行宏，或者回到Excel界面，点击「开发工具」→「宏」，选择BatchRemoveXlsPasswords执行

• 确保Excel的宏安全性设置为「中等」（文件→选项→信任中心→信任中心设置→宏设置），否则宏无法运行
• 运行前建议关闭其他无关的Excel文件，避免文件占用冲突
• 如果遇到文件无法打开的情况，可能是文件损坏，需要单独检查

内容的提问来源于stack exchange，提问作者Emman D.