Shell to Another Application and Wait Until it Finishes

Category:

Miscellaneous

Type:

Snippets

Difficulty:

Advanced

Author:

Intelligent Solutions Inc.

Version Compatibility:

More information:

The Visual Basic Shell command does not let you open the shelled-to application synchronously (that is, your program continues to execute while the shelled-to application runs). The code below overcomes this by allowing you to shell to another application and suspend execution of your program until the child application is finished. The optional TimeOutValue parameter allows you to specify the maximum amount of time to wait in seconds before resuming execution of your program.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit Private Declare Function OpenProcess Lib "kernel32" _ (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, _ ByVal dwProcessId As Long) As Long Private Declare Function GetExitCodeProcess Lib "kernel32" _ (ByVal hProcess As Long, lpExitCode As Long) As Long Private Const STATUS_PENDING = &H103& Private Const PROCESS_QUERY_INFORMATION = &H400

Code:

Public Function ShellandWait(ExeFullPath As String, _
Optional TimeOutValue As Long = 0) As Boolean
    
    Dim lInst As Long
    Dim lStart As Long
    Dim lTimeToQuit As Long
    Dim sExeName As String
    Dim lProcessId As Long
    Dim lExitCode As Long
    Dim bPastMidnight As Boolean
    
    On Error GoTo ErrorHandler

lStart = CLng(Timer)
    sExeName = ExeFullPath

'Deal with timeout being reset at Midnight
    If TimeOutValue > 0 Then
        If lStart + TimeOutValue < 86400 Then
            lTimeToQuit = lStart + TimeOutValue
        Else
            lTimeToQuit = (lStart - 86400) + TimeOutValue
            bPastMidnight = True
        End If
    End If

lInst = Shell(sExeName, vbMinimizedNoFocus)
    
lProcessId = OpenProcess(PROCESS_QUERY_INFORMATION, False, lInst)

Do
        Call GetExitCodeProcess(lProcessId, lExitCode)
        DoEvents
        If TimeOutValue And Timer > lTimeToQuit Then
            If bPastMidnight Then
                 If Timer < lStart Then Exit Do
            Else
                 Exit Do
            End If
    End If
    Loop While lExitCode = STATUS_PENDING
    
    ShellandWait = True
   
ErrorHandler:
ShellandWait = False
Exit Function
End Function