VBA：VBAProjectのパスワード強制解除方法(Office32bit用)
- VBAを編集したいがパスワードが分からなくなってしまった。
- 前任者がいなくなったので、編集パスワードが分からない
そんな場合に強制的にVBAProjectのパスワードを解除する方法を記事にしておきます。
１．状況
VBAを編集しようとすると、以下のようにパスワードが出てきて編集ができない状態です。
|
２．解除手順
(1)以下の２つのファイルを利用します。
「パスワードあり.xlsm」はパスワードが分からなくなってしまったファイルです。
「VBAPWD解除ツール.xlsm」はパスワードを解除するVBAのツールです。
 |
VBEを開くと以下のようにVBAProjectが2つ開いた状態になります。
 |
VBAProjectを2つ開いた状態のまま、「VBAPWD解除ツール.xlsm」の「Sub パスワード強制解除」を実行します。
※VBAの詳細は次の「３．「VBAPWD解除ツール.xlsm」のVBA」に記載しています。
 |
上記VBAを実行すると「パスワード解除が完了しました。」とメッセージが出ます。
VBAProjectを確認するととパスワードのかかっていたVBAが開くようになります。
 |
「パスワードあり.xlsm」のVBAProjectのプロパティを右クリック等で開き、「保護」部分を下記のように何も入っていないようにして保存する。
これで次からはパスワードを入れなくても、VBAの編集ができるようになります。
 |
３．「VBAPWD解除ツール.xlsm」のVBA
「VBAPWD解除ツール.xlsm」のVBAは以下のようになります。
一番下に実行する「Sub パスワード強制解除」があります。
※動作はOffice2013、2016の32bitで行っています。64bitでは動きません。
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 |
Option Explicit Public Const PAGE_EXECUTE_READWRITE = &H40 Public Declare Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As LongPtr, Source As LongPtr, ByVal Length As LongPtr) Public Declare Function VirtualProtect Lib "kernel32" (lpAddress As LongPtr, ByVal dwSize As LongPtr, ByVal flNewProtect As LongPtr, lpflOldProtect As LongPtr) As LongPtr Public Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongPtr Public Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As LongPtr, ByVal lpProcName As String) As LongPtr Public Declare 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 hBytes(0 To 5) As Byte Dim oBytes(0 To 5) As Byte Dim pFunction As Long Dim Flag As Boolean '**************************************************' Public Function getPtr(ByVal Value As LongPtr) As LongPtr getPtr = Value End Function '**************************************************' Public Sub reBytes() If Flag Then MoveMemory ByVal pFunction, ByVal VarPtr(oBytes(0)), 6 End Sub '**************************************************' Public Function dialogboxParamater(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 dialogboxParamater = 1 Else reBytes dialogboxParamater = dialogboxParamater(hInstance, pTemplateName, hWndParent, lpDialogFunc, dwInitParam) hFlag End If End Function '**************************************************' Public Function hFlag() As Boolean Dim tmpBytes(0 To 5) As Byte Dim p As Long Dim OriginProtect As Long hFlag = False pFunction = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA") If VirtualProtect(ByVal pFunction, 6, PAGE_EXECUTE_READWRITE, OriginProtect) <> 0 Then MoveMemory ByVal VarPtr(tmpBytes(0)), ByVal pFunction, 6 If tmpBytes(0) <> &H68 Then MoveMemory ByVal VarPtr(oBytes(0)), ByVal pFunction, 6 p = getPtr(AddressOf dialogboxParamater) hBytes(0) = &H68 MoveMemory ByVal VarPtr(hBytes(1)), ByVal VarPtr(p), 4 hBytes(5) = &HC3 MoveMemory ByVal pFunction, ByVal VarPtr(hBytes(0)), 6 Flag = True hFlag = True End If End If End Function '**************************************************' Sub パスワード強制解除() If hFlag Then MsgBox "パスワード解除が完了しました。" End If End Sub |
以上簡単ですが、VBAProjectパスワードが分からなくなった場合の対処方法でした。
