如何破解<em>excel</em> vba<em>密码</em>

如果Excel文件的打开密码忘记了，且密码是6位数以内的数字，可用以下步骤解开（关掉所有程序，为了速度）：
新开一Excel，同时按Alt和F11，进入7a64e58685e5aeb9339VBA界面，点菜单上的插入，模块，在新出来的窗口粘贴一下代码：
Sub crack()
Dim i As Long
Dim FileName As String
i = 0
FileName = Application.GetOpenFilename("Excel文件（*.xls & *.xlsx）,*.xls;*.xlsx", , "VBA破解")
FileName = Right(FileName, Len(FileName) - InStrRev(FileName, "\"))
Application.ScreenUpdating = False
line2: On Error GoTo line1
Workbooks.Open FileName, , True, , i
MsgBox "Password is " & i
Exit Sub
line1: i = i + 1
Resume line2
Application.ScreenUpdating = True
End Sub

然后在此界面直接按F5运行此宏，选择文件，等啊等（看密码长度了）

Sub MoveProtect()
    Dim FileName As String
    FileName = Application.GetOpenFilename("Excel文件（*.xlsm & *.xlam）,*.xlsm;*.xlam", , "VBA破解")
    If FileName = CStr(False) Then
       Exit Sub
    Else
       VBAPassword FileName, False
    End If
End Sub

Private Function VBAPassword(FileName As String, Optional Protect As Boolean = False)
      If Dir(FileName) = "" Then
         Exit Function
      Else
         FileCopy FileName, FileName & ".bak"
      End If

      Dim GetData As String * 5
      Open FileName For Binary As #1
      Dim CMGs As Long
      Dim DPBo As Long
      For i = 1 To LOF(1)
          Get #1, i, GetData
          If GetData = "CMG=""" Then CMGs = i
          If GetData = "[Host" Then DPBo = i - 2: Exit For
      Next
      If CMGs = 0 Then
         MsgBox "请先对VBA编码设置一个保护密码...", 32, "提示"
         Exit Function
      End If
      If Protect = False Then
         Dim St As String * 2
         Dim s20 As String * 1
         '取得一个0D0A十六进制字串
         Get #1, CMGs - 2, St
         '取得一个20十六制字串
         Get #1, DPBo + 16, s20
         '替换加密部份7a64e78988e69d83365机码
         For i = CMGs To DPBo Step 2
             Put #1, i, St
         Next
         '加入不配对符号
         If (DPBo - CMGs) Mod 2 <> 0 Then
            Put #1, DPBo + 1, s20
         End If
         MsgBox "文件解密成功......", 32, "提示"
      Else
         Dim MMs As String * 5
         MMs = "DPB="""
         Put #1, CMGs, MMs
         MsgBox "对文件特殊加密成功......", 32, "提示"
      End If
      Close #1
End Function

首先以下方案只针对 Word 文档和 Excel 文档的 VBA 工程密码。

打开一个 Excel 的程序实例（无论待破解的e799bee5baa6e79fa5e98193e59b9ee7ad94336是什么文档一律打开 Excel 实例），按 Alt + F11 打开 VBE，左侧“工程资源管理器”右键新建一个模块，复制下列代码粘贴进去后定位至过程 VBA_Password_remove 按 F5 运行选择要破解的包含工程密码的文件。

Option Explicit
Private Sub VBA_Password_remove()
    Dim Filename As String, i As Integer
    Filename = Application.Caption
    If InStr(Filename, "Excel") > 0 Then
        Filename = openfile()
    Else
        MsgBox "请在 Microsoft Office Excel Visual Basic of Application 环境下运行本程序！", vbExclamation
        Exit Sub
    End If
    If (Filename = "False") Then Exit Sub
    If Dir(Filename) = "" Then
        MsgBox "未找到指定文件"
        Exit Sub
    Else
        FileCopy Filename, Filename & ".bak"
    End If
    Dim GetData As String * 5
    Open Filename For Binary As #1
    Dim CMGs As Long
    Dim DPBo As Long
    For i = 1 To LOF(1)
        Get #1, i, GetData
        If GetData = "CMG=""" Then CMGs = i
        If GetData = "[Host" Then DPBo = i - 2: Exit For
    Next
    If CMGs = 0 Then
        Close #1
        MsgBox "VBA 工程未设置密码", vbQuestion, "提示"
        Exit Sub
    End If
    Dim St As String * 2
    Dim s20 As String * 1
    Get #1, CMGs - 2, St
    Get #1, DPBo + 16, s20
    For i = CMGs To DPBo Step 2
        Put #1, i, St
    Next
    If (DPBo - CMGs) Mod 2 <> 0 Then Put #1, DPBo + 1, s20
    MsgBox "文件解密成功！", vbQuestion, "提示"
    Close #1
End Sub
Function openfile()
    openfile = Application.GetOpenFilename("Excel 文件（*.xls & *.xla & *.xlt）,*.xls;*.xla;*.xlt,Word 文件（*.doc & *.dot ）,*.doc;*.dot", , "选择破解 VBA 工程密码的文件")
End Function

重装一遍excel，正版的