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