I have an MS Access database which contains a password-protected VB Project. The password is unknown. The Access database itself does not have a password, so I can open it: I just can't expand the VB Project tree in the VBE.
If this were Excel, it would be a simple matter. An excellent guide to bypassing an Excel VB Project password can be found right here on Stack Overflow: Is there a way to crack the password on an Excel VBA Project?
While the code in the above-referenced answer doesn't appear to be application-specific, I can't get it to work with Access. I believe that this is because in Excel, the same Application object can contain multiple workbooks, and therefore even if one workbook's VB Project is password-protected, you can run this code from modules in a different workbook - and the protection-removal will apply to all workbooks in the Application.
In Access, however, the Application object only holds one current database at a time. I can see no way to open multiple databases in the same Application. What I have tried is to create a new Access VB Project in a fresh Application: insert the password-removing modules as per the Excel answer; then from that VB Project, execute a sub which creates a new Access Application, and load the protected database into it - before running the unprotect script. However this didn't work. It seems that the script doesn't work across separate instances of the Application - even if they're both recognised at runtime.
In my work environment I cannot install new software, and have no access to a hex editor. Thus, is there a way to crack the MS Access VB Project password?
Clarifications
With regards providing code examples, I am a long-time user of Stack Exchange and am intimately familiar with the problem of new users asking questions along the line of "Can you help me?" without actually showing their code: however questions will not always require code to be contained.
If it helps, what I have been trying is as follows:
Sub DoVBA()
Dim app As Application
Dim filepath As String
'filepath = Application.CurrentProject.Path & "\CCD-QAF_v0.6.mdb"
filepath = Application.CurrentProject.Path & "\CCD-QAF_v0.6_OC2016.accdb"
'
Set app = New Application
app.Visible = True
app.OpenCurrentDatabase filepath
unprotected ' Calls sub which works in Excel
End Sub
Sub unprotected()
If Hook Then
MsgBox "VBA Project is unprotected!", vbInformation, "*****"
End If
End Sub
.. and then in a different module:
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
The above has been copied from the Excel example in the linked question, which works perfectly in Excel - but does nothing in Access. This is probably because in Excel, you can run this code in one workbook - which acts on all the other workbooks running within the same Excel application. However Access only allows one database per application.
