【Excel VBA】VBAプロジェクトのロックを強制的に解除する【マクロ】

※自作マクロのパスワードを忘れちゃったときなど、常識の範囲で実施しましょう。
※解除は全て自己責任で実施してください。何かあっても一切の責任を負いません。

通常であれば、「マクロ　パスワード解除」とかでググれば沢山の方法が見つかります。

例えば
www.saka-en.com

neos21.hatenablog.com

tristore.net

このへんでしょうか。
まずはこれで試してください。

今回は、上記方法でダメだった場合の"もしかしたら"解除出来る方法について記載します。
※解除できなくても責めないでくださいね

まず、こちらに記載されているコードを標準モジュールに貼り付けます。
Excel VBAマクロ パスワード解除方法 | ホームページ制作のサカエン（墨田区）

すると、こんな感じのエラーになってしまいました。

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 FunctionVirtualProtect 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

ダメ元で実行してみます。

当然ですが、エラーになります。
どうやらこのコードは32bit用なので、64bitには対応していないようです。

とりあえず、以下のエラー内容でググります。

コンパイルエラー：

このプロジェクトのコードは、64 ビット システムで使用するために

更新する必要があります。Declare ステートメントの確認および更新

を行い、次に Declare ステートメントに PtrSafe 属性を設定してく

ださい。

見つけました。
piyopiyocs.blog115.fc2.com

↑記事によると、「Declare」の後ろに「PtrSafe」をつければよいと書いています。

試してみると、たしかにコードが赤くなくなった！

いざ、実行！！！！！！

ガーン...＿|￣|○

問題となっているのは、ココ

仕方ないので更にググります。

すると発見！！！！！
Cracking Excel VBA Password 64-bit and 32-bitcalebhengeveld.wordpress.com

こちらには32bitと64bitの両方のコードを書いてくれています。

使っているExcelは64bit版なので、こちらのコードをモジュール1に貼り付けます。

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

マクロの実行で[unprotected]を実行します。

結果は...？

できました！！
「VBA Project is unprotected!」
が表示されたら成功です。

よかったよかった＼(^o^)／