VBA Shell and Wait with Exit Code VBA Shell and Wait with Exit Code vba vba

VBA Shell and Wait with Exit Code


Have a look at WaitForSingleObject and GetExitCodeProcess functions.

Example Usage:

Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As LongPrivate Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As LongPrivate Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As LongPrivate Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As LongPrivate Declare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Any, ByVal dwMessageId As Long, ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, Arguments As Long) As LongPublic Const INFINITE = &HFFFFPublic Const PROCESS_ALL_ACCESS = &H1F0FFFSub RunApplication(ByVal Cmd as String)    lTaskID = Shell(Cmd, vbNormalFocus)    ' Get process handle    lPID = OpenProcess(PROCESS_ALL_ACCESS, True, lTaskID)    If lPID Then        ' Wait for process to finish        Call WaitForSingleObject(lPID, INFINITE)        ' Get Exit Process        If GetExitCodeProcess(lPID, lExitCode) Then            ' Received value            MsgBox "Successfully returned " & lExitCode, vbInformation        Else            MsgBox "Failed: " & DLLErrorText(Err.LastDllError), vbCritical        End If    Else        MsgBox "Failed: " & DLLErrorText(Err.LastDllError), vbCritical    End If    lTaskID = CloseHandle(lPID)End SubPublic Function DLLErrorText(ByVal lLastDLLError As Long) As String    Dim sBuff As String * 256    Dim lCount As Long    Const FORMAT_MESSAGE_ALLOCATE_BUFFER = &H100, FORMAT_MESSAGE_ARGUMENT_ARRAY = &H2000    Const FORMAT_MESSAGE_FROM_HMODULE = &H800, FORMAT_MESSAGE_FROM_STRING = &H400    Const FORMAT_MESSAGE_FROM_SYSTEM = &H1000, FORMAT_MESSAGE_IGNORE_INSERTS = &H200    Const FORMAT_MESSAGE_MAX_WIDTH_MASK = &HFF    lCount = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS, 0, lLastDLLError, 0&, sBuff, Len(sBuff), ByVal 0)    If lCount Then        DLLErrorText = Left$(sBuff, lCount - 2) ' Remove line feeds    End IfEnd Function


This functionality has been wrapped up in the ShellAndWait function.

Excellent write up on it here.