Determine when a shelled process ends in VBA

Question

I need to shell out to a web browser, login to a website and then return to the VBA code and continue processing. I have tried the code at https://learn.microsoft.com/en-us/office/vba/access/concepts/windows-api/determine-when-a-shelled-process-ends but this does not work with MS Edge (or Opera, Chrome or Firefox). I have tried calling the executable directly as "C:\Program Files (x86)\Microsoft\Edge\Application\msedge.exe" but this still does not work. I had to change the functions to PtrSafe.

The code runs ok but when it gets to the lines

' Wait for the shelled application to finish: 
Do 
   ReturnValue = WaitForSingleObject(proc.hProcess, 0) 
   DoEvents 
Loop Until ReturnValue <> 258

The return value is 0 even though Edge is still open so it does not wait.

I am running MS-Access 2016 on Window 10 64 bit

CODE:

Private Type STARTUPINFO
    cb As Long
    lpReserved As String
    lpDesktop As String
    lpTitle As String
    dwX As Long
    dwY As Long
    dwXSize As Long
    dwYSize As Long
    dwXCountChars As Long
    dwYCountChars As Long
    dwFillAttribute As Long
    dwFlags As Long
    wShowWindow As Integer
    cbReserved2 As Integer
    lpReserved2 As Long
    hStdInput As Long
    hStdOutput As Long
    hStdError As Long
End Type

Private Type PROCESS_INFORMATION
    hProcess As Long
    hThread As Long
    dwProcessID As Long
    dwThreadID As Long
End Type

Private Declare PtrSafe Function WaitForSingleObject Lib "kernel32" (ByVal _
    hHandle As LongPtr, ByVal dwMilliseconds As Long, ByVal bAlertable As Long) As Long

Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
    lpApplicationName As LongPtr, ByVal lpCommandLine As String, ByVal _
    lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, _
    ByVal bInheritHandles As LongPtr, ByVal dwCreationFlags As LongPtr, _
    ByVal lpEnvironment As LongPtr, ByVal lpCurrentDirectory As LongPtr, _
    lpStartupInfo As STARTUPINFO, lpProcessInformation As _
    PROCESS_INFORMATION) As Long

Private Declare PtrSafe Function CloseHandle Lib "kernel32" (ByVal _
    hObject As LongPtr) As Long

Private Const NORMAL_PRIORITY_CLASS = &H20&
Private Const INFINITE = -1&


Public Sub ExecCmd(cmdline As String)
Dim proc As PROCESS_INFORMATION
Dim start As STARTUPINFO
Dim ReturnValue As Integer


' Initialize the STARTUPINFO structure:
start.cb = Len(start)

' Start the shelled application:
ReturnValue = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc)

' Wait for the shelled application to finish:
Do
ReturnValue = WaitForSingleObject(proc.hProcess, 1, 0)
DoEvents
Loop Until ReturnValue <> 258

ReturnValue = CloseHandle(proc.hProcess)
End Sub

Why not use Selenium and login within the VBA code instead of shelling out? https://stackoverflow.com/a/57224810/12502175 — peterb, Sep 18 '21 at 21:05
Have you tried notepad to verify your code works and you haven't broken stuff by incorrectly adding `PtrSafe` (you need to convert the code to actually use the proper size pointer). — Erik A, Sep 18 '21 at 21:11
Thanks peterb, if I use selenium I would still have the problem that the web login has to complete before the rest of the code continues, that is why I was shelling out or is there a way to achieve this with selenium. — user63103, Sep 19 '21 at 06:31
How did you adapt the API functions for 64 bit? Only inserting `PtrSafe` between `Declare` and function? Did you also adapt 'STARTUPINFO` and `PROCESS_INFORMATION` types? Can you edit your question and share the code you use? — FaneDuru, Sep 19 '21 at 16:53
HI FaneDuru, I added PtrSafe and changed to LongPtr but did not do anything with the 'STARTUPINFO` and PROCESS_INFORMATION types. I have added the code. — user63103, Sep 19 '21 at 21:13
From what I can see when the code WaitForSingleObject(proc.hProcess, 1, 0) runs the first time the return value is 256 but then when it loops it returns 0 the second time. As if when the process is created the then starts another second process which is the MS Edge application - if that makes sense ? — user63103, Sep 19 '21 at 21:18
There should be modifications (`LongPtr` instead `Long`) in the two used `Types`. I will post them as they should be (for 64 bit). I will also look to the rest of the code. — FaneDuru, Sep 20 '21 at 09:11

FaneDuru · Answer 1 · 2021-09-20T09:43:25.117

Please, change the two used Type declarations as following and CreateProcess should return a LongPtr:

     Private Type STARTUPINFO       
        cb              As Long    
        padding1        As Long
        lpReserved      As String  
        lpDesktop       As String  
        lpTitle         As String  
        dwX             As Long    
        dwY             As Long    
        dwXSize         As Long    
        dwYSize         As Long    
        dwXCountChars   As Long    
        dwYCountChars   As Long    
        dwFillAttribute As Long    
        dwFlags         As Long    
        wShowWindow     As Integer
        cbReserved2     As Integer
        padding2        As Long
        lpReserved2     As LongPtr '!!!
        hStdInput       As LongPtr '!!!
        hStdOutput      As LongPtr '!!!
        hStdError       As LongPtr '!!!
    End Type                  

    Private Type PROCESS_INFORMATION
        hProcess    As LongPtr '!!!
        hThread     As LongPtr '!!!
        dwProcessID As Long
        dwThreadID  As Long
    End Type

    Private Declare PtrSafe Function CreateProcessA Lib "kernel32" (ByVal _
             lpApplicationName As LongPtr, ByVal lpCommandLine As String, ByVal _
             lpProcessAttributes As LongPtr, ByVal lpThreadAttributes As LongPtr, _
             ByVal bInheritHandles As LongPtr, ByVal dwCreationFlags As LongPtr, _
             ByVal lpEnvironment As LongPtr, ByVal lpCurrentDirectory As LongPtr, _
             lpStartupInfo As STARTUPINFO, lpProcessInformation As _
                                            PROCESS_INFORMATION) As LongPtr '!!!

Then, (in the used Sub) Dim ReturnValue As Integer should be changed in Dim ReturnValue As LongPtr.

Please, test it and send some feedback.

I tested for Edge application and it waits for process termination.

I have made the changes but it does not stay in the "Wait for the shelled application to finish" loop The ReturnValue from the CreateProcessA call is 1^ but the Return Value from the WaitForSingleObject call is 0^ so execution drops out of the loop ' Start the shelled application: ReturnValue = CreateProcessA(0&, cmdline$, 0&, 0&, 1&, NORMAL_PRIORITY_CLASS, 0&, 0&, start, proc) ' Wait for the shelled application to finish: Do ReturnValue = WaitForSingleObject(proc.hProcess, 1, 0) DoEvents Loop Until ReturnValue <> 258 — user63103, Sep 20 '21 at 15:35
@user63103 Do you mean that the **"Process Finished" message is shown before you close the Edge process**? If yes, this is not happening in my case. The message appears **only after I close the process/Edge window**. If not, what do you want accomplishing? For now, please forget about what the variables return and please focus on answering my questions. I am asking them in order to check what is different in my code, in case the answer at my first question is yes... — FaneDuru, Sep 20 '21 at 18:36
Yes I have this code on a button Private Sub Command13_Click() ExecCmd "MicrosoftEdge www.google.co.uk" MsgBox "Process Finished" End Sub and the message comes up while Edge is still open but is hidden behind edge. What I want to achieve is the code to wait while edge is open and only continue when edge is closed. — user63103, Sep 20 '21 at 19:10

Determine when a shelled process ends in VBA

1 Answers1

Linked