Option Explicit

Private Const STILL_ACTIVE                  As Long = &H103
Private Const PROCESS_QUERY_INFORMATION     As Long = &H400

Private Declare Function EnumProcesses Lib "PSAPI.DLL" (lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
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 OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
   
Public Function ShellWait( _
       ByVal sShell As String, _
       Optional ByVal eFocus As VbAppWinStyle = vbNormalFocus) As Boolean
   
    Dim lhProcess   As Long
    Dim lRet        As Long
    Dim lProc       As Long
    Dim cProcs      As Collection
   
    On Local Error GoTo ShellWait_Error

    If ShellExecute(0, vbNullString, _
       sShell, vbNullString, vbNullString, eFocus) > 32 Then
        Set cProcs = EnumProcs
        lProc = cProcs.Item(cProcs.Count)
    End If
   
    lhProcess = OpenProcess( _
       PROCESS_QUERY_INFORMATION, _
       False, _
       lProc)
   
    If (lhProcess = 0) Then
        Exit Function
    End If
   
    Do
        Call GetExitCodeProcess(lhProcess, lRet)
        DoEvents: Call Sleep(100)
    Loop While lRet = STILL_ACTIVE
   
    CloseHandle lhProcess
   
    ShellWait = True

    On Error GoTo 0
    Exit Function

ShellWait_Error:

End Function

Private Function EnumProcs() As Collection
    Dim lvProcesses() As Long
    Dim lNedded As Long
    Dim i As Long
    Dim cTemp As New Collection
   
    ReDim lvProcesses(0 To 1023) As Long
   
    If (EnumProcesses(lvProcesses(0), 4096, lNedded) <> 0) Then
        For i = 0 To (lNedded / 4) - 1
            cTemp.Add lvProcesses(i)
        Next i
    End If
    Set EnumProcs = cTemp
End Function