有没有办法破解Excel VBA项目的密码？

我被要求更新一些Excel 2003宏，但是VBA项目有密码保护，而且似乎缺少文档。。。没有人知道密码

---

有没有办法删除或破解VBA项目上的密码？

该保护是Excel中的简单文本比较。

---

将Excel加载到您最喜欢的调试器中（这是我选择的工具），找到进行比较的代码并将其修复为始终返回true，这样您就可以访问宏。

是的，只要您使用的是

.xls

格式的电子表格（2003年以前Excel的默认设置）。对于Excel 2007及以后的版本，默认值为

.xlsx

，这是一种相当安全的格式，此方法将不起作用

正如特雷布所说，这是一个简单的比较。一种方法是使用十六进制编辑器简单地交换文件中的密码条目（请参阅）。逐步示例：

创建一个新的简单excel文件

在VBA部分中，设置一个简单的密码（例如-1234）

保存文件并退出然后检查文件大小-请参阅

打开刚用十六进制编辑器创建的文件

复制以以下键开头的行：

CMG=....
DPB=...
GC=...

首先备份您不知道VBA密码的excel文件，然后用十六进制编辑器打开它，并粘贴从虚拟文件复制的上述行

保存excel文件并退出

现在，打开需要查看VBA代码的excel文件。VBA代码的密码 将只是1234（如我在这里展示的示例中所示）

如果您需要使用Excel2007或2010，下面有一些其他答案可能会有所帮助，特别是这些：

---

编辑2015年2月：对于另一种看起来非常有前景的方法，请参见ứ陈恩圭ễn

科林·皮卡德（Colin Pickard）有一个很好的答案，但这其中有一个“小心”。在某些情况下（我还没有找出原因），文件中“CMG=…..GC=…..”项的总长度在excel文件之间是不同的。在某些情况下，该条目将为137字节，而在其他情况下，该条目将为143字节。137字节的长度是奇数，如果在使用“1234”密码创建文件时发生这种情况，只需创建另一个文件，它应该跳到143字节的长度

如果尝试将错误的字节数粘贴到文件中，则在尝试使用Excel打开文件时，将丢失VBA项目

编辑

这对Excel 2007/2010文件无效。标准的.xlsx文件格式实际上是一个.zip文件，其中包含许多子文件夹，其格式、布局、内容等存储为xml数据。对于未受保护的Excel2007文件，只需将.xlsx扩展名更改为.zip，然后打开zip文件并查看所有xml数据。这很简单

---

但是，当您对Excel 2007文件进行密码保护时，整个.zip（.xlsx）文件实际上是使用RSA加密进行加密的。无法再将扩展名更改为.zip并浏览文件内容

Tom-起初我犯了一个小学生错误，因为我没有观察字节大小，而是从“CMG”设置复制并粘贴到后续条目。不过，这两个文件之间有两个不同的文本大小，正如Bob警告的那样，我丢失了VBA项目

使用HxD，有一个计数器跟踪您选择的文件数量。从CMG开始复制，直到计数器读取8F（十六进制表示143），粘贴到锁定文件时也是如此——粘贴结束时，我得到了两倍于“…”的数字，这看起来有些奇怪，感觉几乎不自然，但它起了作用

我不知道这是否重要，但我确保在excel中重新打开文件之前关闭了十六进制编辑器和excel。然后，我必须通过菜单打开VB编辑器，进入VBProject属性并输入“新”密码来解锁代码

---

我希望这会有所帮助。

制作了高级Office密码破解和高级Office密码恢复产品，只要文档是在Office 2007或更早版本中创建的。

您尝试过在OpenOffice.org中打开它们吗

不久前，我遇到了类似的问题，发现Excel和Calc不理解彼此的加密，因此允许直接访问几乎所有内容

这是一段时间以前的事了，所以如果这不是我的侥幸，它也可能已经被修补了。

还有另一个（稍微容易一些）解决方案，没有尺寸问题。我今天使用了这种方法（在2003 XLS文件上，使用Excel2007），并取得了成功

备份xls文件

在十六进制编辑器中打开文件并找到

DPB=…

部分

将

DPB=…

字符串更改为

DPx=…

在Excel中打开xls文件

打开VBA编辑器（ALT+F11）

魔法： Excel发现一个无效密钥（DPx）并询问是否要继续加载项目（基本上忽略保护）

您将能够覆盖密码，因此将其更改为您可以记住的内容

保存xls文件*

关闭并重新打开文档，使用VBA魔术

---

*注意：请确保您已将密码更改为新值，否则下次打开电子表格Excel时将报告错误（意外错误），然后当您访问VBA模块列表时，您现在将看到源模块的名称，但在尝试打开表单/代码/等时会收到另一个错误。要解决此问题，返回VBA项目属性并将密码设置为新值。保存并重新打开Excel文档，您就可以开始了

Colin Pickard基本上是正确的，但不要将整个文件的“打开密码”保护与t混淆

CMG="..."
DPB="..."
GC="..."

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As Long, Source As Long, ByVal Length As Long)

Private Declare Function VirtualProtect Lib "kernel32" (lpAddress As Long, _
        ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtect As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, _
        ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As Long
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As Long) As Long
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long

    Hook = False

    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


    If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then

            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

            p = GetPtr(AddressOf MyDialogBoxParam)

            HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3

            MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integer
    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                           hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)

Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _
ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr

Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr

Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _
ByVal lpProcName As String) As LongPtr

Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As LongPtr
    Dim OriginProtect As LongPtr

    Hook = False

    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")


    If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then

            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

            p = GetPtr(AddressOf MyDialogBoxParam)

            HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3

            MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub

Sub PasswordBreaker()

'Breaks worksheet password protection.

Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer
Dim i1 As Integer, i2 As Integer, i3 As Integer
Dim i4 As Integer, i5 As Integer, i6 As Integer
On Error Resume Next
For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
If ActiveSheet.ProtectContents = False Then
MsgBox "One usable password is " & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _
Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next: Next: Next: Next: Next: Next
Next: Next: Next: Next: Next: Next
End Sub

Sheets("Sheet1").Unprotect Password:="blabla"

Option Explicit

Private Const PAGE_EXECUTE_READWRITE = &H40

Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr)

Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, _
ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr

Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr

Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, _
ByVal lpProcName As String) As LongPtr

Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

Dim HookBytes(0 To 11) As Byte
Dim OriginBytes(0 To 11) As Byte
Dim pFunc As LongPtr
Dim Flag As Boolean

Private Function GetPtr(ByVal Value As LongPtr) As LongPtr
    GetPtr = Value
End Function

Public Sub RecoverBytes()
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 12
End Sub

Public Function Hook() As Boolean
    Dim TmpBytes(0 To 11) As Byte
    Dim p As LongPtr, osi As Byte
    Dim OriginProtect As LongPtr

    Hook = False

    #If Win64 Then
        osi = 1
    #Else
        osi = 0
    #End If

    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")

    If VirtualProtect(ByVal pFunc, 12, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then

        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, osi+1
        If TmpBytes(osi) <> &HB8 Then

            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 12

            p = GetPtr(AddressOf MyDialogBoxParam)

            If osi Then HookBytes(0) = &H48
            HookBytes(osi) = &HB8
            osi = osi + 1
            MoveMemory ByVal VarPtr(HookBytes(osi)), ByVal VarPtr(p), 4 * osi
            HookBytes(osi + 4 * osi) = &HFF
            HookBytes(osi + 4 * osi + 1) = &HE0

            MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 12
            Flag = True
            Hook = True
        End If
    End If
End Function

Private Function MyDialogBoxParam(ByVal hInstance As LongPtr, _
ByVal pTemplateName As LongPtr, ByVal hWndParent As LongPtr, _
ByVal lpDialogFunc As LongPtr, ByVal dwInitParam As LongPtr) As Integer

    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                   hWndParent, lpDialogFunc, dwInitParam)
        Hook
    End If
End Function

Sub unprotected()
    If Hook Then
        MsgBox "VBA Project is unprotected!", vbInformation, "*****"
    End If
End Sub