|   |
Shell an application and wait asynchronously for completion
 Download the ShellWait project files (11kb)
The downloadable sample requires the SSubTmr.DLL component because it includes my UpDown custom control. Make sure you have loaded and registered this before trying the ShelWait project. Alternatively, just copy the code below!
Surprisingly often it comes in handy to be able to shell another application and wait for
it to complete. This sample shows what I think is the best way to do it. At least, this
method has been totally reliable for me. Its better than some methods I have seen because
the application isn't frozen whilst the shelled application runs. Therefore the
display is kept refreshed and it doesn't look like the app has hung.
The method makes use of the Win32 OpenProcess method. Here is the code:
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Const STILL_ACTIVE = &H103
Private Const PROCESS_QUERY_INFORMATION = &H400
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Public Function ShellAndWaitForTermination( _
        sShell As String, _
        Optional ByVal eWindowStyle As VBA.VbAppWinStyle = vbNormalFocus, _
        Optional ByRef sError As String, _
        Optional ByVal lTimeOut As Long = 2000000000 _
    ) As Boolean
Dim hProcess As Long
Dim lR As Long
Dim lTimeStart As Long
Dim bSuccess As Boolean
   
On Error GoTo ShellAndWaitForTerminationError
   
    ' This is v2 which is somewhat more reliable:
    hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, Shell(sShell, eWindowStyle))
    If (hProcess = 0) Then
        sError = "This program could not determine whether the process started. Please watch the program and check it completes."
        ' Only fail if there is an error - this can happen when the program completes too quickly.
    Else
        bSuccess = True
        lTimeStart = timeGetTime()
        Do
            ' Get the status of the process
            GetExitCodeProcess hProcess, lR
            ' Sleep during wait to ensure the other process gets
            ' processor slice:
            DoEvents: Sleep 100
            If (timeGetTime() - lTimeStart > lTimeOut) Then
                ' Too long!
                sError = "The process has timed out."
                lR = 0
                bSuccess = False
            End If
        Loop While lR = STILL_ACTIVE
    End If
    ShellAndWaitForTermination = bSuccess
       
    Exit Function
ShellAndWaitForTerminationError:
    sError = Err.Description
    Exit Function
End Function
For more flexibility, you might want to replace the VB Shell call with a call to the ShellExecute
API function instead. See my article Using ShellExecute from Visual Basic - start any document from its filename only
for more details.
Back to top
Back to Source Code Overview
|
  |
