0% found this document useful (0 votes)
115 views

VBA Macros - Protecting

The document discusses protecting VBA projects with passwords and describes methods for locking projects, submitting passwords at runtime to unlock projects, and breaking worksheet protection by trying all character combinations for the password.

Uploaded by

Qumisoft 78
Copyright
© © All Rights Reserved
Available Formats
Download as PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
115 views

VBA Macros - Protecting

The document discusses protecting VBA projects with passwords and describes methods for locking projects, submitting passwords at runtime to unlock projects, and breaking worksheet protection by trying all character combinations for the password.

Uploaded by

Qumisoft 78
Copyright
© © All Rights Reserved
Available Formats
Download as PDF, TXT or read online on Scribd
You are on page 1/ 7

VBA Macros - Protecting

Excel Online VBA Add-ins C# Add-ins Quant Online Consultancy

VBA Add-ins
Protecting
Macros
You can protect your VBA projects with passwords although your code is
Troubleshooting ... not 100% secure.
Adding a password will deter the average user though.
Visual Basic Editor*
You can protect your code by locking the project for viewing and providing
Macro Settings ... a password (Tools > VBAProject Properties)(Protection tab, "Lock
project for viewing").
Running ...
SS
Shortcut Keys

Recording
The name might vary depending whether you have renamed the project
Deleting

Saving
You cannot apply a locked this project password if there is no VBA code
Timing and the file extension is .xlsx
Protecting

Undoing VBAProject
Application Class The default name used for every VBA project is "VBAProject"
You can change the name of your project to something else, although not
Interrupting
many people do this.
Best Practices If the name of your project has been changed the menu option will not be
(Tools > VBAProject Properties) but will be the new name of the project.
Code Modules

Subroutines ...

Functions ...

Arguments ...
Is the Project Protected

Application.ScreenUpdating Public Function Project_IsProtected() As Boolean


... Dim objProject As VBIDE.VBProject

Windows API ... On Error Goto ErrorHandler


   If Val(Application.Version) >= 10 Then
Registry ...       Set objProject = ThisWorkbook.VBProject
      If (objProject Is Nothing) Then Project_IsProtected = True
Region and    End If
Language ...    Exit Function

Advanced ...
ErrorHandler:
Updates ...    Project_IsProtected = True
End Sub
Feedback

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]


VBA Macros - Protecting

Updated: 07
December 2016 Project Is Unviewable
KB - 211792
Save the Excel workbook (.xls) file into an add-in (File > SaveAs.....)
After you have the saved add-in (.xla), close the Excel workbook (.xls)
Double click on the add-in to open it
Press Alt+F11 to access the add-in's vba project
Lock the vba-project with a password
Double-click on the "ThisWorkbook" code module
Press F4 to open the Properties window
Change the "IsAddin" status to FALSE
Return to Excel by Pressing Alt+Q (or close the vbe window)
Go to Tools > Share Workbook
When the dialog appears, check the box for: (Allow changes by.....)
Press OK to close the Dialog
When prompted to save, Press OK
Press Ok to accept that "macros cannot be accessed"
You should feel giddy at this point because you just realized what you have
been missing right under your nose
Verify that the [SHARED] appears in the application title bar
Now save the workbook again as an Add-in (File > SaveAs...) overwriting
the previous one
Close this Excel workbook without saving the changes (you don't need it)
Test out your newly saved add-in (open it, access the vbe, try to expand
the project window, you should get the new message "Project is
Unviewable"

Breaking Worksheet Protection

Sub PasswordBreaker2()
    Dim i As Integer, j As Integer, k As Integer
    Dim l As Integer, m As Integer, n As Integer
    Dim i1 As Integer, i2 As Integer, i3 As Integer
    Dim i4 As Integer, i5 As Integer, i6 As Integer
    On Error Resume Next
    For i = 65 To 66: For j = 65 To 66: For k = 65 To 66
    For l = 65 To 66: For m = 65 To 66: For i1 = 65 To 66
    For i2 = 65 To 66: For i3 = 65 To 66: For i4 = 65 To 66
    For i5 = 65 To 66: For i6 = 65 To 66: For n = 32 To 126
    ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
        Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
        Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
    If ActiveSheet.ProtectContents = False Then
        MsgBox "One usable password is " & Chr(i) & Chr(j) & _
            Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & _

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]


VBA Macros - Protecting

            Chr(i3) & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)


         Exit Sub
    End If
    Next: Next: Next: Next: Next: Next
    Next: Next: Next: Next: Next: Next
End Sub

VBA Project - Submitting Password


http://www.siddharthrout.com/2013/04/24/unprotecting-vba-project-
password-using-a-password-that-you-know/
Unlocking the project at run-time using code.

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _


(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA
" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long
 
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTex
tA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Lo
ng
 
Private Declare Function GetWindowTextLength Lib "user32" Alias _
GetWindowTextLengthA (ByVal hwnd As Long) As Long
 
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA"
_
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam A
s Any) As Long
 
Dim Ret As Long, ChildRet As Long, OpenRet As Long
Dim strBuff As String, ButCap As String
Dim MyPassword As String
 
Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5
 
Sub UnlockVBA()
    Dim xlAp As Object, oWb As Object
 
    Set xlAp = CreateObject("Excel.Application")
 
    xlAp.Visible = True
 

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]


VBA Macros - Protecting

'~~> Open the workbook in a separate instance


    Set oWb = xlAp.Workbooks.Open("C:\Sample.xlsm")
 
'~~> Launch the VBA Project Password window
'~~> I am assuming that it is protected. If not then
'~~> put a check here.
    xlAp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Exec
ute
 
'~~> Your passwword to open then VBA Project
    MyPassword = "Blah Blah"
 
'~~> Get the handle of the "VBAProject Password" Window
    Ret = FindWindow(vbNullString, "VBAProject Password")
 
    If Ret <> 0 Then
'MsgBox "VBAProject Password Window Found"
 
'~~> Get the handle of the TextBox Window where we need to type
the password
        ChildRet = FindWindowEx(Ret, ByVal 0&, "Edit", vbNullString)
 
        If ChildRet <> 0 Then
'MsgBox "TextBox's Window Found"
'~~> This is where we send the password to the Text Window
            SendMess MyPassword, ChildRet
 
            DoEvents
 
'~~> Get the handle of the Button's "Window"
            ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullStri
ng)
 
'~~> Check if we found it or not
            If ChildRet <> 0 Then
'MsgBox "Button's Window Found"
 
'~~> Get the caption of the child window
                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr
$(0))
                GetWindowText ChildRet, strBuff, Len(strBuff)
                ButCap = strBuff
 
'~~> Loop through all child windows
                Do While ChildRet <> 0
'~~> Check if the caption has the word "OK"
                    If InStr(1, ButCap, "OK") Then
'~~> If this is the button we are looking for t
hen exit
                        OpenRet = ChildRet
                        Exit Do
                    End If
 
'~~> Get the handle of the next child window

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]


VBA Macros - Protecting

                    ChildRet = FindWindowEx(Ret, ChildRet, "Button", vb


NullString)
'~~> Get the caption of the child window
                    strBuff = String(GetWindowTextLength(ChildRet) + 1,
Chr$(0))
                    GetWindowText ChildRet, strBuff, Len(strBuff)
                    ButCap = strBuff
                Loop
 
'~~> Check if we found it or not
                If OpenRet <> 0 Then
'~~> Click the OK Button
                    SendMessage ChildRet, BM_CLICK, 0, vbNullString
                Else
                    MsgBox "The Handle of OK Button was not found"
                End If
            Else
                 MsgBox "Button's Window Not Found"
            End If
        Else
            MsgBox "The Edit Box was not found"
        End If
    Else
        MsgBox "VBAProject Password Window was not Found"
    End If
End Sub
 
Sub SendMess(Message As String, hwnd As Long)
    Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)
End Sub

VBA Project - ByPassing Password


http://stackoverflow.com/questions/1026483/is-there-a-way-to-crack-the-
password-on-an-excel-vba-project

This provides a way to open a VBA project bypassing the password.


This will work on any files (.xls, .xlsm, xlam)
When you try and open a VBA Project a password dialog box is displayed
asking the user to enter the password.
This dialog box can be bypassing and it is possible to trick Excel into
thinking that the password has been submitted.
The code below replaces the "check and display the password dialog box"
with "password has been submitted correctly".
Open a new blank workbook and paste in the following code in a new
module "Module1".

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]


VBA Macros - Protecting

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 Lo


ng, _
        ByVal dwSize As Long, ByVal flNewProtect As Long, lpflOldProtec
t As Long) As Long

Private Declare Function GetModuleHandleA Lib "kernel32" (ByVal lpModul


eName As String) As Long

Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule A


s Long, _
        ByVal lpProcName As String) As Long

Private Declare Function DialogBoxParam Lib "user32" Alias "DialogBoxPa


ramA" (ByVal hInstance As Long, _
        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integ
er

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 Sub BreakingPassword1()


    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long

    pFunc = GetProcAddress(GetModuleHandleA("user32.dll"), "DialogBoxPa


ramA")

    If VirtualProtect(ByVal pFunc, 6, PAGE_EXECUTE_READWRITE, OriginPro


tect) <> 0 Then

        MoveMemory ByVal VarPtr(TmpBytes(0)), ByVal pFunc, 6


        If TmpBytes(0) <> &H68 Then

            MoveMemory ByVal VarPtr(OriginBytes(0)), ByVal pFunc, 6

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]


VBA Macros - Protecting

           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
        End If
    End If
End Sub

Private Function MyDialogBoxParam(ByVal hInstance As Long, _


        ByVal pTemplateName As Long, ByVal hWndParent As Long, _
        ByVal lpDialogFunc As Long, ByVal dwInitParam As Long) As Integ
er
    If pTemplateName = 4070 Then
        MyDialogBoxParam = 1
    Else
        RecoverBytes
        MyDialogBoxParam = DialogBoxParam(hInstance, pTemplateName, _
                           hWndParent, lpDialogFunc, dwInitParam)
                           
        Call BreakingPassword1
    End If
End Function

Paste the following code in a new module "Module2".

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

Then open the workbook that contains the password protected VBA
project.

Important
If you VBA Project contains NO VBA code but is password protected it will
be treated exactly the same as a project that does not contain VBA code.

© 2016 Better Solutions Limited | Contact Us | All Rights Reserved

http://bettersolutions.com/vba/macros/protecting.htm[12/09/16 12:18:33 AM]

You might also like