2007版本ACCESS VBA工程密码忘记了，打不开自己的工程了，有没有办法呀？急，

最近我也遇到同样的问题，在百度上找很久找不到，最后在谷歌上找到了老外的解决方法，非常EASY，分享给需要的人：

装一个Hex Editor，我用的是UltraEdit绿色版

用editor打开access文件

搜索文本“DPB”，将B替换为X

保存文件，然后用access打开编辑后的文件，打开VBA工程。遇到错误提示一路点确定。

重新设置VBA密码

详情可以看这里：网页链接

如果要查看别人的有密码保护的VBA代码，可使用此程序。使用方法：新建Excel工作簿, 打开VBA编辑器,新建一模块 ,复制以下代码。然后运行MoveProtect程序。运行过程中会出现提示，以指示要破解的文件路径和名称。被破解的文件一定是关闭状态的。

Sub MoveProtect()

Dim FileName As String

FileName = Application.GetOpenFilename_

("Excel文件（*.xls &*.xla）,*.xls*.xla", , "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 '替换加密部份机码

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

所谓破解只是清除VBA密码，并不是真正的破解。

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

打开一个 Excel 的程序实例（无论待破解的是什么文档一律打开 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

---