Protecting

You can protect your VBA projects with passwords although your code is not 100% secure.
Adding a password will deter the average user though.
You can protect your code by locking the project for viewing and providing a password (Tools > VBAProject Properties)(Protection tab, "Lock project for viewing").
SS


Code Editor > Project Properties
The name might vary depending whether you have renamed the project
You cannot apply a locked this project password if there is no VBA code and the file extension is .xlsx


VBAProject

The default name used for every VBA project is "VBAProject"
You can change the name of your project to something else, although not many people do this.
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.



Is the Project Protected

Public Function Project_IsProtected() As Boolean 
Dim objProject As VBIDE.VBProject

On Error Goto ErrorHandler
   If Val(Application.Version) >= 10 Then
      Set objProject = ThisWorkbook.VBProject
      If (objProject Is Nothing) Then Project_IsProtected = True
   End If
   Exit Function

ErrorHandler:
   Project_IsProtected = True
End Sub

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) & _
            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 "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
 
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 As 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
 
'~~> 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).Execute
 
'~~> 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", vbNullString)
 
'~~> 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 then exit
                        OpenRet = ChildRet
                        Exit Do
                    End If
 
'~~> Get the handle of the next child window
                    ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
'~~> 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".


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 Sub BreakingPassword1()
    Dim TmpBytes(0 To 5) As Byte
    Dim p As Long
    Dim OriginProtect As Long

    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
        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 Integer
    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.


© 2019 Better Solutions Limited. All Rights Reserved. © 2019 Better Solutions Limited TopPrevNext