Unprotect VBProject from VB code

EDIT:

Converted this to a BLOG post for VBA and VB.Net.

I have never been in favor of Sendkeys. They are reliable in some case but not always. I have a soft corner for API's though.

What you want can be achieved, however you have to ensure that workbook for which you want to un-protect the VBA has to be opened in a separate Excel Instance.

Here is an example

Let's say we have a workbook who's VBA project looks like this currently.

LOGIC:

1. Find the Handle of the "VBAProject Password" window using FindWindow

2. Once that is found, find the handle of the Edit Box in that window using FindWindowEx

3. Once the handle of the Edit Box is found, simply use SendMessage to write to it.

4. Find the handle of the Buttons in that window using FindWindowEx

5. Once the handle of the OK button is found, simply use SendMessage to click it.

RECOMMENDATION:

1. For API's THIS is the best link I can recommend.

2. If you wish to become good at API's like FindWindow, FindWindowEx and SendMessage then get a tool that gives you a graphical view of the system’s processes, threads, windows, and window messages. For Ex: uuSpy or Spy++.

Here is what Spy++ will show you for "VBAProject Password" window

TESTING:

Open a new Excel instance and paste the below code in a module.

CODE: (TRIED AND TESTED)

I have commented the code so you shouldn't have any problem understanding it.

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 LongPrivate 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 LongPrivate 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 LongDim strBuff As String, ButCap As StringDim MyPassword As StringConst WM_SETTEXT = &HCConst BM_CLICK = &HF5Sub 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 IfEnd SubSub SendMess(Message As String, hwnd As Long)    Call SendMessage(hwnd, WM_SETTEXT, False, ByVal Message)End Sub

I know you've locked this for new answers but I had a few issues with the above code, principally that I'm working in Office 64-bit (VBA7). However I also made it so the code would work in the current instance of Excel and added a bit more error checking and formatted it up to be pasted into a separate module with only the method UnlockProject exposed.

For full disclosure I really started with the code in this post although it's a variant on a theme.

The code also shows conditional compilation constants so that it ought to be compatible with both 32-bit and 64-bit flavours of Excel at the same time. I used this page to help me with figuring this out.

Anyways here's the code. Hope someone finds it useful:

Option Explicit#If VBA7 Then    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr    Private Declare PtrSafe Function GetParent Lib "user32" (ByVal hWnd As LongPtr) As LongPtr    Private Declare PtrSafe Function GetDlgItem Lib "user32" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long) As LongPtr ' nIDDlgItem = int?    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long    Private Declare PtrSafe Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As LongPtr) As LongPtr    Private Declare PtrSafe Function LockWindowUpdate Lib "user32" (ByVal hWndLock As LongPtr) As Long    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal uIDEvent As LongPtr) As Long    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#Else    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, ByVal lpszClass As String, ByVal lpszWindow As String) As Long    Private Declare Function GetParent Lib "user32" (ByVal hWnd As Long) As Long    Private Declare Function GetDlgItem Lib "user32" (ByVal hDlg As Long, ByVal nIDDlgItem As Long) As Long ' nIDDlgItem = int?    Private Declare Function GetDesktopWindow Lib "user32" () As Long    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, lParam As Any) As Long    Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long    Private Declare Function LockWindowUpdate Lib "user32" (ByVal hWndLock As Long) As Long    Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long    Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal uIDEvent As Long) As Long    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)#End IfPrivate Const WM_CLOSE As Long = &H10Private Const WM_GETTEXT As Long = &HDPrivate Const EM_REPLACESEL As Long = &HC2Private Const EM_SETSEL As Long = &HB1Private Const BM_CLICK As Long = &HF5&Private Const TCM_SETCURFOCUS As Long = &H1330&Private Const IDPassword As Long = &H155E&Private Const IDOK As Long = &H1&Private Const TimeoutSecond As Long = 2Private g_ProjectName    As StringPrivate g_Password       As StringPrivate g_Result         As Long#If VBA7 Then    Private g_hwndVBE        As LongPtr    Private g_hwndPassword   As LongPtr#Else    Private g_hwndVBE        As Long    Private g_hwndPassword   As Long#End IfSub Test_UnlockProject()    Select Case UnlockProject(ActiveWorkbook.VBProject, "Test")        Case 0: MsgBox "The project was unlocked"        Case 2: MsgBox "The active project was already unlocked"        Case Else: MsgBox "Error or timeout"    End SelectEnd SubPublic Function UnlockProject(ByVal Project As Object, ByVal Password As String) As Long#If VBA7 Then    Dim lRet As LongPtr#Else    Dim lRet As Long#End IfDim timeout As Date    On Error GoTo ErrorHandler    UnlockProject = 1    ' If project already unlocked then no need to do anything fancy    ' Return status 2 to indicate already unlocked    If Project.Protection <> vbext_pp_locked Then        UnlockProject = 2        Exit Function    End If    ' Set global varaibles for the project name, the password and the result of the callback    g_ProjectName = Project.Name    g_Password = Password    g_Result = 0    ' Freeze windows updates so user doesn't see the magic happening :)    ' This is dangerous if the program crashes as will 'lock' user out of Windows    ' LockWindowUpdate GetDesktopWindow()    ' Switch to the VBE    ' and set the VBE window handle as a global variable    Application.VBE.MainWindow.Visible = True    g_hwndVBE = Application.VBE.MainWindow.hWnd    ' Run 'UnlockTimerProc' as a callback    lRet = SetTimer(0, 0, 100, AddressOf UnlockTimerProc)    If lRet = 0 Then        Debug.Print "error setting timer"        GoTo ErrorHandler    End If    ' Switch to the project we want to unlock    Set Application.VBE.ActiveVBProject = Project    If Not Application.VBE.ActiveVBProject Is Project Then GoTo ErrorHandler    ' Launch the menu item Tools -> VBA Project Properties    ' This will trigger the password dialog    ' which will then get picked up by the callback    Application.VBE.CommandBars.FindControl(ID:=2578).Execute    ' Loop until callback procedure 'UnlockTimerProc' has run    ' determine run by watching the state of the global variable 'g_result'    ' ... or backstop of 2 seconds max    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)    Do While g_Result = 0 And Now() < timeout        DoEvents    Loop    If g_Result Then UnlockProject = 0ErrorHandler:    ' Switch back to the Excel application    AppActivate Application.Caption    ' Unfreeze window updates    LockWindowUpdate 0End Function#If VBA7 Then    Private Function UnlockTimerProc(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) As Long#Else    Private Function UnlockTimerProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) As Long#End If#If VBA7 Then    Dim hWndPassword As LongPtr    Dim hWndOK As LongPtr    Dim hWndTmp As LongPtr    Dim lRet As LongPtr#Else    Dim hWndPassword As Long    Dim hWndOK As Long    Dim hWndTmp As Long    Dim lRet As Long#End IfDim lRet2 As LongDim sCaption As StringDim timeout As DateDim timeout2 As DateDim pwd As String    ' Protect ourselves against failure :)    On Error GoTo ErrorHandler    ' Kill timer used to initiate this callback    KillTimer 0, idEvent    ' Determine the Title for the password dialog    Select Case Application.LanguageSettings.LanguageID(msoLanguageIDUI)        ' For the japanese version        Case 1041            sCaption = ChrW(&H30D7) & ChrW(&H30ED) & ChrW(&H30B8) & _                        ChrW(&H30A7) & ChrW(&H30AF) & ChrW(&H30C8) & _                        ChrW(&H20) & ChrW(&H30D7) & ChrW(&H30ED) & _                        ChrW(&H30D1) & ChrW(&H30C6) & ChrW(&H30A3)        Case Else            sCaption = " Password"    End Select    sCaption = g_ProjectName & sCaption    ' Set a max timeout of 2 seconds to guard against endless loop failure    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)    Do While Now() < timeout        hWndPassword = 0        hWndOK = 0        hWndTmp = 0        ' Loop until find a window with the correct title that is a child of the        ' VBE handle for the project to unlock we found in 'UnlockProject'        Do            hWndTmp = FindWindowEx(0, hWndTmp, vbNullString, sCaption)            If hWndTmp = 0 Then Exit Do        Loop Until GetParent(hWndTmp) = g_hwndVBE        ' If we don't find it then could be that the calling routine hasn't yet triggered        ' the appearance of the dialog box        ' Skip to the end of the loop, wait 0.1 secs and try again        If hWndTmp = 0 Then GoTo Continue        ' Found the dialog box, make sure it has focus        Debug.Print "found window"        lRet2 = SendMessage(hWndTmp, TCM_SETCURFOCUS, 1, ByVal 0&)        ' Get the handle for the password input        hWndPassword = GetDlgItem(hWndTmp, IDPassword)        Debug.Print "hwndpassword: " & hWndPassword        ' Get the handle for the OK button        hWndOK = GetDlgItem(hWndTmp, IDOK)        Debug.Print "hwndOK: " & hWndOK        ' If either handle is zero then we have an issue        ' Skip to the end of the loop, wait 0.1 secs and try again        If (hWndTmp And hWndOK) = 0 Then GoTo Continue        ' Enter the password ionto the password box        lRet = SetFocusAPI(hWndPassword)        lRet2 = SendMessage(hWndPassword, EM_SETSEL, 0, ByVal -1&)        lRet2 = SendMessage(hWndPassword, EM_REPLACESEL, 0, ByVal g_Password)        ' As a check, get the text back out of the pasword box and verify it's the same        pwd = String(260, Chr(0))        lRet2 = SendMessage(hWndPassword, WM_GETTEXT, Len(pwd), ByVal pwd)        pwd = Left(pwd, InStr(1, pwd, Chr(0), 0) - 1)        ' If not the same then we have an issue        ' Skip to the end of the loop, wait 0.1 secs and try again        If pwd <> g_Password Then GoTo Continue        ' Now we need to close the Project Properties window we opened to trigger        ' the password input in the first place        ' Like the current routine, do it as a callback        lRet = SetTimer(0, 0, 100, AddressOf ClosePropertiesWindow)        ' Click the OK button        lRet = SetFocusAPI(hWndOK)        lRet2 = SendMessage(hWndOK, BM_CLICK, 0, ByVal 0&)        ' Set the gloabal variable to success to flag back up to the initiating routine        ' that this worked        g_Result = 1        Exit Do        ' If we get here then something didn't work above        ' Wait 0.1 secs and try again        ' Master loop is capped with a longstop of 2 secs to terminate endless loopsContinue:        DoEvents        Sleep 100    Loop    Exit Function    ' If we get here something went wrong so close the password dialog box (if we have a handle)    ' and unfreeze window updates (if we set that in the first place)ErrorHandler:    Debug.Print Err.Number    If hWndPassword <> 0 Then SendMessage hWndPassword, WM_CLOSE, 0, ByVal 0&    LockWindowUpdate 0End Function#If VBA7 Then    Function ClosePropertiesWindow(ByVal hWnd As LongPtr, ByVal uMsg As Long, ByVal idEvent As LongPtr, ByVal dwTime As Long) As Long#Else    Function ClosePropertiesWindow(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long) As Long#End If#If VBA7 Then    Dim hWndTmp As LongPtr    Dim hWndOK As LongPtr    Dim lRet As LongPtr#Else    Dim hWndTmp As Long    Dim hWndOK As Long    Dim lRet As Long#End IfDim lRet2 As LongDim timeout As DateDim sCaption As String    ' Protect ourselves against failure :)    On Error GoTo ErrorHandler    ' Kill timer used to initiate this callback    KillTimer 0, idEvent    ' Determine the Title for the project properties dialog    sCaption = g_ProjectName & " - Project Properties"    Debug.Print sCaption    ' Set a max timeout of 2 seconds to guard against endless loop failure    timeout = Now() + TimeSerial(0, 0, TimeoutSecond)    Do While Now() < timeout        hWndTmp = 0        ' Loop until find a window with the correct title that is a child of the        ' VBE handle for the project to unlock we found in 'UnlockProject'        Do            hWndTmp = FindWindowEx(0, hWndTmp, vbNullString, sCaption)            If hWndTmp = 0 Then Exit Do        Loop Until GetParent(hWndTmp) = g_hwndVBE        ' If we don't find it then could be that the calling routine hasn't yet triggered        ' the appearance of the dialog box        ' Skip to the end of the loop, wait 0.1 secs and try again        If hWndTmp = 0 Then GoTo Continue        ' Found the dialog box, make sure it has focus        Debug.Print "found properties window"        lRet2 = SendMessage(hWndTmp, TCM_SETCURFOCUS, 1, ByVal 0&)        ' Get the handle for the OK button        hWndOK = GetDlgItem(hWndTmp, IDOK)        Debug.Print "hwndOK: " & hWndOK        ' If either handle is zero then we have an issue        ' Skip to the end of the loop, wait 0.1 secs and try again        If (hWndTmp And hWndOK) = 0 Then GoTo Continue        ' Click the OK button        lRet = SetFocusAPI(hWndOK)        lRet2 = SendMessage(hWndOK, BM_CLICK, 0, ByVal 0&)        ' Set the gloabal variable to success to flag back up to the initiating routine        ' that this worked        g_Result = 1        Exit Do        ' If we get here then something didn't work above        ' Wait 0.1 secs and try again        ' Master loop is capped with a longstop of 2 secs to terminate endless loopsContinue:        DoEvents        Sleep 100    Loop    Exit Function    ' If we get here something went wrong so unfreeze window updates (if we set that in the first place)ErrorHandler:    Debug.Print Err.Number    LockWindowUpdate 0End Function

@James Macadie's answer (above) is the best I found (I'm running 32-bit Excel 365/2019)

Note: I found that you must have Application.ScreenUpdating = True in order to call James' method via a different sub or function. Otherwise, you may get an Invalid procedure call or argument error (if running outside of debug-mode).

This solution appears superior to both of the following:

1. http://www.siddharthrout.com/index.php/2019/01/20/unprotect-vbproject-from-vb-code/. creates a separate Excel Application instance to run the unlock process which didn't work for my use case

2. https://www.mrexcel.com/board/threads/lock-unlock-vbaprojects-programmatically-without-sendkeys.1136415/. unstable and would fail if run sequentially for multiple workbooks, I think due to a lack of the timer/waiting loops implemented in James' solution - I didn't thoroughly debug the problem