Deblocare parola Excel Macro VBA

Rezolvare problema (Fix IT)

Situatie

Avem un Macro cu parola pentru un fisier Excel. Situatia impune modificarea codului Macro din VBA, insa din diverse motive nu putem afla parola.

Simptome

Parola Macro-ului este impusa din motive de securitate si acordare permisiuni pe care le pot avea anumiti utilizatori.

Solutie

Pasi de urmat

Intram in Developer -> Visual Basic;

Deschidem un alt fisier Excel, astfel incat in Visual Basic sa avem acces la alt VBA Project.

In VBA Project pentru cel de-al doilea fisier cream 2 noi Module: Click dreapta pe ThisWorkbook -> Insert -> Module.

 

In primul Modul inseram codul de mai jos:

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

In cel de-al doilea Modul inseram codul de mai jos:

Sub unprotected()
If Hook Then
MsgBox “VBA Project is unprotected!”, vbInformation, “*****”
End If
End Sub

Rulam Macroul -> OK.

Deschidem Macroul parolat si accesam sheet-urile necesare.

Tip solutie

Permanent
Etichetare:

Voteaza

(15 din 29 persoane apreciaza acest articol)

Despre Autor