VBA Code to Close Excel Automatically if in Idle Mode (Win32 APIs)

Question

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

EDIT: as my previous thread was badly rated because I did not provide code to illustrate my problem, here it is. This is not exactly simple, but as minimal as it gets. I did not post it before because 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

Answer 1

I managed to detect window creation (in the same process for now) with WinEvents.

But, if I schedule calls without a minimum delay, the WinEventProc keeps receiving EVENT_OBJECT_CREATE event messages associated with the "EXCEL7" window (the sheet portion with the cells) indefinitely. This occurs with the DEMO 1 and DEMO 3 parts in my code below, but not with DEMO 2 and DEMO 4. Once the flow of event messages has started, I can't even call the unhook function, the VBE is always busy, so I need to force quit the EXCEL.EXE process...

Do you know why? I am just trying to grasp the concepts at work here. A 10 ms delay to workaround this is fine by me otherwise.

Option Explicit

'--------------------------------------
'--------------------------------------
    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

Dim strBuff As String, WndCap As String

Public i As Long
'--------------------------------------
'--------------------------------------

Private Const WINEVENT_OUTOFCONTEXT = 0

Private Const EVENT_OBJECT_CREATE = &H8000&

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 GetCurrentProcessId Lib "kernel32" () As Long
Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long

Private Declare Function UnhookWinEvent Lib "user32.dll" ( _
      ByVal hWinEventHook As Long) As Long

Private pRunningHandles As Collection

Public Function StartEventHook() As Long
  If pRunningHandles Is Nothing Then Set pRunningHandles = New Collection
  'StartEventHook = SetWinEventHook(EVENT_SYSTEM_FOREGROUND, EVENT_SYSTEM_FOREGROUND, 0&, AddressOf WinEventProc, 0, 0, WINEVENT_OUTOFCONTEXT)
  StartEventHook = SetWinEventHook(EVENT_OBJECT_CREATE, EVENT_OBJECT_CREATE, 0&, AddressOf WinEventProc, 0&, 0&, WINEVENT_OUTOFCONTEXT)
  pRunningHandles.Add StartEventHook
End Function

Public Sub StopEventHook(lHook As Long)
  Dim LRet As Long
  If lHook = 0 Then Exit Sub
 
  LRet = UnhookWinEvent(lHook)
 
End Sub

Public Sub StartHook()
    i = 1
    StartEventHook
End Sub

Public Sub StopAllEventHooks()
  Dim vHook As Variant, lHook As Long
  For Each vHook In pRunningHandles
    lHook = vHook
    StopEventHook lHook
  Next vHook
End Sub

Public Sub WinEventProc(ByVal HookHandle 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)
  'This function is a callback passed to the win32 api
  'We CANNOT throw an error or break. Bad things will happen.
  On Error Resume Next
  Dim thePID As Long
 
  If LEvent = EVENT_OBJECT_CREATE Then
    GetWindowThreadProcessId hwnd, thePID
    If thePID = GetCurrentProcessId Then
     
        'MANUAL COMPILE SEEMS REQUIRED IF CHANGES ARE MADE BELOW, OTHERWISE EXCEL MAY CRASH
     
        strBuff = String(GetWindowTextLength(hwnd) + 1, Chr$(0))
        GetWindowText hwnd, strBuff, Len(strBuff)
        WndCap = strBuff
        WndCap = Left(WndCap, Len(WndCap) - 1) 'removing the trailing null char otherwise the Application.OnTime procedure string is cut
     
        i = i + 1
     
    
        'DEMO 1
        Application.OnTime Now, "EVENT_OBJECT_CREATE_1"

        'DEMO 2
        Application.OnTime Now + TimeSerial(0, 0, 1), "EVENT_OBJECT_CREATE_1"
     
        'DEMO 3
        Application.OnTime Now, "'EVENT_OBJECT_CREATE_3 """ & CStr(thePID) & """,""" & CStr(hwnd) & """,""" & WndCap & """'"
     
        'DEMO 4
        If WndCap Like "*Projet verrouillé*" Then
            Application.OnTime Now, "'EVENT_OBJECT_CREATE_3 """ & CStr(thePID) & """,""" & CStr(hwnd) & """,""" & WndCap & """'"
        End If
     
    End If
  End If
 
  On Error GoTo 0
End Sub

Public Sub EVENT_OBJECT_CREATE_1()
  
    DoEvents 'Excel crashes without DoEvents because to many event messages are received
  
    Feuil1.Cells(i, 2).Value = "EVENT_OBJECT_CREATE"
End Sub

Public Sub EVENT_OBJECT_CREATE_2(PID As Long, hwnd As Long, WndCap As String)
  
    DoEvents 'Excel crashes without DoEvents because to many event messages are received
  
    Debug.Print i, "EVENT_OBJECT_CREATE", PID, Hex(hwnd), WndCap
End Sub