Prevent VBE from idling when user action is required (Win32 APIs)

[hymced]

Hi all, Hi Jaafar

I am working on a tool manipulating the VBProject of other Excel files, which can have their VBProject locked with 2 different passwords. But I have no way to know which one it will be in advanced, so I must attempt them one after the other. I managed to write some code that runs in a main Excel.Application instance so that I can work on the VBE windows of the other Excel.Application instance (containing the locked project) to input a password. I sucessfully unlocked some projects this way (I found this solution more elegant and 100% working compared to the SendKeys method that gives random results and would not work in my particular case)

One can verify I do end up with 2 different Excel processes, because I have 2 VBE Window in my Windows Task Bar:



But when the password is incorrect, a "Project Locked / Invalid password" dialog appears, and it happens to even stop execution in my main running instance using the Win32 APIs. I think it must somehow throw an exception to my main running instance, which requires that the user clicks the "OK" button in the dialog for the execution to continue.



I would like to by-pass this interaction with the user to have something fully automated.

I came with a solution that I have not yet fully carried through: generate a worker file that I would run in a third Excel.Application instance just before confirming the password in the previous dialog, which would detect the "Project Locked / Invalid password" dialog and close it, so the execution can continue in my main running instance, allowing me to try the second password. This workaround seems very heavy and unnatural...

Another quick workaround is to use the Sendkeys method of the locked project's Application to send an {ESC} key just before confirming the password. This works to close the error dialog, giving back control to the main VBE. But the whole point of my tool is to avoid using SendKeys...

Would there be another way? One that would prevent the VBE from idling in my main running instance (making the dialog modeless, etc. I really don't know...)

Here is the code to illustrate my problem. This is not exactly simple, but as minimal as it gets. I think it is meaningless for anybody capable of understanding the problem with major principles, and able of giving me hints to workaround this issue...

NOTE: look for my 3 comments in CAPITAL LETTERS

#If VBA7 Then
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hwnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As Long
    Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
   
    Dim Ret As LongPtr, ChildRet As LongPtr, OpenRet As LongPtr
#Else
    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
#End If

Dim strBuff As String, ButCap As String

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5

Const WORKAROUND1_SENDKEYS_ESC = True

Sub Main()
    Call UnlockVBA("password1")
End Sub

Sub UnlockVBA(ByVal pwd As String)
   
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = -1
    Set Wb = xlApp.Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & "DUMMY_LOCKED_VBPROJECT.xlsm", UpdateLinks:=False)
    Set vbProj = Wb.VBProject
    Set xlApp.VBE.ActiveVBProject = vbProj
   
    DoEvents
   
    xlApp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
   
    DoEvents
   
    Ret = FindWindow(vbNullString, vbProj.Name & " Password")
   
    If Ret <> 0 Then
       
        '~~> 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
            '~~> Type the password in the TextBox Window
            SendMess pwd, ChildRet
            DoEvents
           
            '~~> Search for the "OK" Button among siblings of the TextBox Child Window
            '~~> Get the handle of the first Child Window of class "Button"
            ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
            If ChildRet <> 0 Then
                '~~> 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
                        OKRet = 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 OKRet <> 0 Then
                    '~~> Click the OK Button
                   
                    If Not WORKAROUND1_SENDKEYS_ESC Then
                        MsgBox "before user click"
                    ElseIf WORKAROUND1_SENDKEYS_ESC Then
                        xlApp.SendKeys "{ESC}"
                    End If
                    SendMessage OKRet, BM_CLICK, 0, vbNullString
                    ' >>> IF INCORRECT PASSWORD, MAIN VBE IDLES HERE UNTIL USER CANCELS THE ERROR IN THE OTHER VBE <<<
                   
                    MsgBox "after user click"
                    ' >>> AT THIS POINT, THE ERROR DIALOG HAS BEEN DISMISSED BY THE USER, I WAS NOT EXPECTING THIS INTERACTION, NEITHER THAT THE ERROR DIALOG WOULD IDLE THE MAIN VBE, SO THE FOLLOWING CODE DOES NOT WORK PROPERLY

                    '~~> Check if password has worked and VBProject Properties Window is displayed
                    Ret = FindWindow(vbNullString, vbProj.Name & " - Project Properties")
                    If Ret <> 0 Then
                        '~~> Get the handle of the first Child Window of class "Button"
                        ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
                        '~~> Check if we found it or not
                        If ChildRet <> 0 Then
                            '~~> Get the caption of the child window
                            strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                            GetWindowText ChildRet, strBuff, Len(strBuff)
                            ButCap = strBuff
                            '~~> Loop through all next 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
                                    OK2Ret = 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 OK2Ret <> 0 Then
               
                                '~~> Click the OK again Button to close VBProject Properties
                                SendMessage OK2Ret, BM_CLICK, 0, vbNullString
                                DoEvents
                               
                                '~~> AT THIS POINT, the VBProject should be unlocked
                           
                            End If
                        End If
                    Else
                       
                        '~~> "Project Locked / Invalid password" Window might be displayed
                       
                        ' #32769 (Desktop Window) "EXCEL.EXE"
                        '   #32770 (Dialog) "Project Locked" (top-level window owned by the top-level dialog window "VBAProject Password", itself owned by the top-level window of class wndclass_desked_gsk "VBE")
                        '       Button "OK"
                        '       Static ""
                        '       Static "Invalid password"
                       
                        'Project Locked
                        '/!\ Invalid password
                       
                        Ret = FindWindow(vbNullString, "Project Locked")
                       
                        If Ret <> 0 Then
                            ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
                            If ChildRet <> 0 Then
                                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                                GetWindowText ChildRet, strBuff, Len(strBuff)
                                ButCap = strBuff
                                Do While ChildRet <> 0
                                    If InStr(1, ButCap, "OK") Then
                                        OK3Ret = ChildRet
                                        Exit Do
                                    End If
                                    ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                                    strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                                    GetWindowText ChildRet, strBuff, Len(strBuff)
                                    ButCap = strBuff
                                Loop
                                If OK3Ret <> 0 Then
                                    SendMessage OK3Ret, BM_CLICK, 0, vbNullString
                                    DoEvents
                                   
                                    '~~> Close VBAProject Password Window
                                   
                                    ' #32769 (Desktop Window) "EXCEL.EXE"
                                    '   #32770 (Dialog) "vbProj.Name Password"
                                    '       Button "OK"
                                    '       Button "Cancel"
                                    '       Static "&Password"
                                    '       Edit ""
                                   
                                    Ret = FindWindow(vbNullString, vbProj.Name & " Password")
                                    If Ret <> 0 Then
                                        ChildRet = FindWindowEx(Ret, ByVal 0&, "Button", vbNullString)
                                        If ChildRet <> 0 Then
                                            strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                                            GetWindowText ChildRet, strBuff, Len(strBuff)
                                            ButCap = strBuff
                                            Do While ChildRet <> 0
                                                If InStr(1, ButCap, "Cancel") Then
                                                    CancelRet = ChildRet
                                                    Exit Do
                                                End If
                                                ChildRet = FindWindowEx(Ret, ChildRet, "Button", vbNullString)
                                                strBuff = String(GetWindowTextLength(ChildRet) + 1, Chr$(0))
                                                GetWindowText ChildRet, strBuff, Len(strBuff)
                                                ButCap = strBuff
                                            Loop
                                            If CancelRet <> 0 Then
                                                SendMessage CancelRet, BM_CLICK, 0, vbNullString
                                                DoEvents
                                               
                                                '~~> Check if VBProject Properties is NOT displayed
                                                Ret = FindWindow(vbNullString, vbProj.Name & " - Project Properties")
                                                If Ret = 0 Then
                                                    '~~> ok! ready to try to call the sub with another password
                                                Else
                                                    '~~> hum...
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            End If
                        End If ' >>> SUB GOES OUT HERE, THE TEXT BOX DIALOG IN THE OTHER VBE IS STILL VISIBLE
                    End If
                End If
            End If
        End If
    End If
End Sub

#If VBA7 Then
    Sub SendMess(Message As String, hWnd As LongPtr)
        Call SendMessage(hWnd, WM_SETTEXT, False, ByVal Message)
    End Sub
#Else
    Sub SendMess(Message As String, hWnd As Long)
        Call SendMessage(hWnd, WM_SETTEXT, False, ByVal Message)
    End Sub
#End If

 

[Jaafar Tribak]

@hymced

In order to avoid being bombarded by repeated EVENT_OBJECT_CREATE events, you could temporarily remove the hook at the start of the WinEventProc procedure and then restore it at the end.

But you shouldn't be using the EVENT_OBJECT_CREATE event in the first place as it fires a lot including for child windows, caret etc...

Instead, you should intercept the EVENT_SYSTEM_DIALOGSTART and EVENT_SYSTEM_DIALOGEND events.

Take a look at the following code: Ah, BTW, you don't need to run this code from a separate excel instance. I think, that by using a separate instance, you are just over-complicating the task.


1- In a Standard Module:

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As LongPtr, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As LongPtr
    Private Declare PtrSafe Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As LongPtr) As Long
    Private Declare PtrSafe Function AccessibleObjectFromEvent Lib "oleacc.dll" (ByVal hwnd As LongPtr, ByVal dwObjectId As Long, ByVal dwChildID As Long, ppacc As IAccessible, pVarChild As Variant) As Long
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function IsWindow Lib "user32" (ByVal hwnd As LongPtr) As Long
    Private Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
    Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr
    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 nIDEvent As LongPtr) As Long
   
    Private hHook As LongPtr
#Else
    Private Declare Function SetWinEventHook Lib "user32.dll" (ByVal eventMin As Long, ByVal eventMax As Long, ByVal hmodWinEventProc As Long, ByVal pfnWinEventProc As Long, ByVal idProcess As Long, ByVal idThread As Long, ByVal dwFlags As Long) As Long
    Private Declare Function UnhookWinEvent Lib "user32.dll" (ByVal hWinEventHook As Long) As Long
    Private Declare Function AccessibleObjectFromEvent Lib "oleacc.dll" (ByVal hwnd As Long, ByVal dwObjectId As Long, ByVal dwChildID As Long, ppacc As IAccessible, pVarChild As Variant) As Long
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function IsWindow Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long
    Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam 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 nIDEvent As Long) As Long

    Private hHook As Long
#End If

'Language dependent constants:
Private Const PROJECT_PROPERTIES_DIALOG = "VBAProject - Project Properties"
Private Const PROJECT_PASSWORD_DIALOG = "VBAProject Password"
Private Const PROJECT_LOCKED_DIALOG = "Project Locked"

Private sPassword As String

   
Public Function UnLockVBAProject( _
        ByVal Project As Object, _
        ByVal Password As String _
    ) As Boolean

    With Application.VBE
        Set .ActiveVBProject = Project
        If .ActiveVBProject.Protection = 0 Then
            MsgBox "VBProject already unlocked": Exit Function
        End If
        If .ActiveVBProject.Protection Then
            sPassword = Password
            Call StartEventHook
            Do
                .CommandBars(1).FindControl(id:=2578, recursive:=True).Execute
                DoEvents
            Loop Until IsWindow(FindWindow(vbNullString, PROJECT_PASSWORD_DIALOG)) = 0
            If Project.Protection = 0 Then
                sPassword = vbNullString
                UnLockVBAProject = True
            End If
        End If
    End With

    Exit Function
errHandler:
    Call StopEventHook
    MsgBox "Runtime Error : " & Err.Number & vbCr & vbCr & Err.Description, vbExclamation

End Function

Private Sub StartEventHook()

    Const EVENT_SYSTEM_DIALOGSTART = &H10
    Const EVENT_SYSTEM_DIALOGEND = &H11
    Const WINEVENT_OUTOFCONTEXT = 0
   
    If hHook = 0 Then
        hHook = SetWinEventHook(EVENT_SYSTEM_DIALOGSTART, EVENT_SYSTEM_DIALOGEND, 0&, _
                        AddressOf WinEventProc, 0&, 0&, WINEVENT_OUTOFCONTEXT)
    End If
   
End Sub

Private Sub StopEventHook()
    If hHook Then
        Call UnhookWinEvent(hHook):  hHook = 0
    End If
End Sub

#If Win64 Then
    Private Sub WinEventProc( _
            ByVal HookId As LongLong, _
            ByVal LEvent As Long, _
            ByVal hwnd As LongLong, _
            ByVal idObject As Long, _
            ByVal idChild As Long, _
            ByVal idEventThread As Long, _
            ByVal dwmsEventTime As Long _
        )
#Else
    Private Sub WinEventProc( _
        ByVal HookId As Long, _
        ByVal LEvent As Long, _
        ByVal hwnd As Long, _
        ByVal idObject As Long, _
        ByVal idChild As Long, _
        ByVal idEventThread As Long, _
        ByVal dwmsEventTime As Long _
            )
#End If

    Const ID_EDIT = 5470
    Const ID_OK = 1
    Const ID_CANCEL = 2
    Const BM_CLICK = &HF5
    Const EVENT_SYSTEM_DIALOGSTART = &H10
    Const EVENT_SYSTEM_DIALOGEND = &H11
   
    Dim vChild As Variant, oAccDlg As IAccessible
 
    If LEvent = EVENT_SYSTEM_DIALOGSTART Then
        If AccessibleObjectFromEvent(hwnd, idObject, idChild, oAccDlg, vChild) = 0& Then
            Select Case oAccDlg.accName(0&)
                Case Is = PROJECT_PASSWORD_DIALOG
                    Call SetDlgItemText(hwnd, ID_EDIT, sPassword)
                    Call SendDlgItemMessage(hwnd, ID_OK, BM_CLICK, 0, 0)
                Case Is = PROJECT_LOCKED_DIALOG
                    Call SendDlgItemMessage(hwnd, ID_CANCEL, BM_CLICK, 0, 0)
            End Select
        End If
    ElseIf LEvent = EVENT_SYSTEM_DIALOGEND Then
        Call SendDlgItemMessage(FindWindow(vbNullString, PROJECT_PASSWORD_DIALOG), ID_CANCEL, BM_CLICK, 0, 0)
        Call SetTimer(Application.hwnd, 0, 0, AddressOf CloseProjectPropDlg)
        Call StopEventHook
    End If
   
End Sub

Private Sub CloseProjectPropDlg()

    Const BM_CLICK = &HF5
    Const ID_CANCEL = 2

    If IsWindow(FindWindow(vbNullString, PROJECT_PROPERTIES_DIALOG)) And _
        FindWindow(vbNullString, PROJECT_PASSWORD_DIALOG) = 0 Then
        Call SendDlgItemMessage(FindWindow(vbNullString, PROJECT_PROPERTIES_DIALOG), ID_CANCEL, BM_CLICK, 0, 0)
    Else
        Call KillTimer(Application.hwnd, 0)
    End If
   
End Sub

2- Code usage example: (VBAProject Password= 1234)

Option Explicit

Sub UnLock_Example()

    Dim oVBProject As Object

    Set oVBProject = Workbooks("MyTestBook.xls").VBProject   '<== Change target workbook name as required.
   
    'Try with first Password.
    If UnLockVBAProject(Project:=oVBProject, Password:="Wrong Password") = False Then
        'If first password was wrong, try with second Password.
        If UnLockVBAProject(Project:=oVBProject, Password:="1234") = True Then   '<== 1234 is the correct password.
            MsgBox "VBAProject successfully unprotected."
        Else
            If oVBProject.Protection = 1 Then
                MsgBox "Failed to unprotect VBAProject."
            End If
        End If
    Else
        MsgBox "VBAProject successfully unprotected."
    End If

End Sub

 

[hymced]

Thank you @JAAFAR, it works like a charm! Indeed, separate instances are no longer required with this method. But I am even more interested about the why than the solution itself. I am sure you have the proper explanation :

Why can a WinEventProc keep running in background asynchrounously when a dialog appears, while the VBE usually freeze and execution of procedures stops, and so even when that dialog appears in an instance different than the one that triggered it?

Why do I get endlessly bombarded by "EXCEL7" window create events when Application.OnTime Now is used? While these event messages do not occur without the Application.OnTime call...

I also noticed 2 classes appearing just before the flow of theses event messages starts:

Caption, Class
OLEChannelWnd, OleMainThreadWndClass
OleMainThreadWndName, OleMainThreadWndClass
CicMarshalWnd

I even been struggling to understand OLE Automation and COM since a few years, and I think it might have something to do with the bombarding...

Thanking you in advance for any input you can have

 

[Jaafar Tribak]

WinEventProc runs asynchronously just like all win32 callbacks. I didn't test your code in post#10 so I don't know about the EXCEL7 events you mention.

EVENT_OBJECT_CREATE captures the creation of all objects and windows.
Taken From the MS Documentation:
"EVENT_OBJECT_CREATE - An object has been created. The system sends this event for the following user interface elements: caret, header control, list-view control, tab control, toolbar control, tree view control, and window object."

So, I guess Windows keeps creating objects\windows (including invisible and internal housekeeping ole windows ) all the time while the code is running. Intercepting the creation of all these objects\windows overwhelms the WinEventProc callback function with endless event messages.

As I mentioned in my last post, EVENT_OBJECT_CREATE is the wrong choice. Here, we are only interested in intercepting the creation\display of the vbaproject password related dialog(s), so we should use EVENT_SYSTEM_DIALOGSTART and EVENT_SYSTEM_DIALOGEND... This should narrow down the number of events being monitored and consequently, will not fire endless event messages that block excel.

Regards.