Remove excel vb password

Remove excel vb password

New a excel and open Visual Basic edit window, then insert a module. Put below code in module.

===============Source Code==========================

Option Explicit
#If Win64 Then
Private Declare PtrSafe Sub MoveMemory Lib "kernel32" Alias "RtlMoveMemory" _
        (Destination As LongLong, Source As LongLong, ByVal Length As LongLong)
Private Declare PtrSafe Function VirtualProtect Lib "kernel32" (lpAddress As LongLong, _
        ByVal dwSize As LongLong, ByVal flNewProtect As LongLong, lpflOldProtect As LongLong) As LongLong
           
Private Declare PtrSafe Function GetModuleHandleA Lib "kernel32" (ByVal lpModuleName As String) As LongLong
      
Private Declare PtrSafe Function GetProcAddress Lib "kernel32" (ByVal hModule As LongLong, _
        ByVal lpProcName As String) As LongLong
      
Private Declare PtrSafe Function DialogBoxParam Lib "user32" Alias "DialogBoxParamA" (ByVal hInstance As LongLong, _
        ByVal pTemplateName As LongLong, ByVal hWndParent As LongLong, _
        ByVal lpDialogFunc As LongLong, ByVal dwInitParam As LongLong) As Integer
Dim HookBytes(0 To 5) As Byte
Dim OriginBytes(0 To 5) As Byte
Dim pFunc As LongLong
Dim Flag As Boolean
#Else
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
        
#End If
#If Win64 Then
Private Function GetPtr(ByVal Value As LongLong) As LongLong
#Else
Private Function GetPtr(ByVal Value As Long) As Long
#End If
    'Get func pointer
    GetPtr = Value
End Function
  
Public Sub RecoverBytes()
    'If hooked then recover pre-API 6byte that alse is recover pre-func's fucntion
    If Flag Then MoveMemory ByVal pFunc, ByVal VarPtr(OriginBytes(0)), 6
End Sub
  
#If Win64 Then
Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As LongLong
    Dim OriginProtect As LongLong
#Else
Public Function Hook() As Boolean
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long
#End If
    Hook = False
    'VBE6.dll call DialogBoxParamA to show VB6INTL.dll resource of dialogbox 4070(that is password dialogbox)
    'If DialogBoxParamA return true, then VBE will belived password correct, so we will hook DialogBoxParamA func
    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxParamA")
    'Standand api hook 1: change memory attribute, make sure that will writeable
    If VirtualProtect(ByVal pFunc, 6, &H40, OriginProtect) <> 0 Then
        'Standand api hook 2: Judge whether hook, look out first byte if is &H68,
        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6
        If TmpBytes(0) <> &H68 Then
            'Standand api hook 3: Save pre-func's first 6bytes for recovery
            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6
            'Get MyDialogBoxParam pointer with AddressOf
            p = GetPtr(AddressOf MyDialogBoxParam)
            'Standand api hook 4: Construct new API enter
            HookBytes(0) = &H68
            MoveMemory ByVal VarPtr(HookBytes(1)), ByVal VarPtr(p), 4
            HookBytes(5) = &HC3
               
            'standand API hook 5: replace API first 6bytes by HookBytes cotent
            MoveMemory ByVal pFunc, ByVal VarPtr(HookBytes(0)), 6
            'set hook done flag
            Flag = True
            Hook = True
        End If
    End If
End Function
  
#If Win64 Then
Private Function MyDialogBoxParam(ByVal hInstance As LongLong, _
        ByVal pTemplateName As LongLong, ByVal hWndParent As LongLong, _
        ByVal lpDialogFunc As LongLong, ByVal dwInitParam As LongLong) As Integer
#Else
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
#End If
    If pTemplateName = 4070 Then
        'someone call Dialogbox with 4070 then return 1,that make VBE believe the password is correct
        MyDialogBoxParam = 1
    Else
        'some call Dialogbox without 4070, we call RecoverBytes to recover pre-func's fucntion, then go pre-func
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                           hWndParent, lpDialogFunc, dwInitParam)
        'pre-func done, call hook again
        Hook
    End If
End Function

=================================================

Go to Sheet1, and put below code in Sheet1 code window.

=============== Source Code ==========================

Sub crack()
If Hook Then
MsgBox "crack done"
End If
End Sub
 
Sub recover()
RecoverBytes
MsgBox "recover done"
End Sub
===================================================

At the end you need open your target excel and run macro of "Sheet1.crack".

All done.