Run Shelled App and Wait Until Finished

Option Explicit

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject 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 WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long

Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = -1&
'-----------------------------------------------------------
Sub Main()
    Dim sPrgm As String
    
    sPrgm = "C:\Winnt\notepad.exe"
    
    RunUntilFinished sPrgm
    
    MsgBox "App is finished!"

    End
End Sub
'-----------------------------------------------------------
Public Sub RunUntilFinished(ByVal sApp As String)
    Dim lProcID As Long
    Dim hProc As Long

    ' Start the App
    On Error GoTo ErrHndlr
    lProcID = Shell(sApp, vbNormalFocus)
    On Error GoTo 0

    DoEvents

    ' Wait for the App
    hProc = OpenProcess(SYNCHRONIZE, 0, lProcID)
    If hProc <> 0 Then
        WaitForSingleObject hProc, INFINITE
        CloseHandle hProc
    End If
    Exit Sub

ErrHndlr:
    MsgBox "Error starting App:" &amp; vbCrLf &amp; _
           "App: " &amp; sApp &amp; vbCrLf &amp; _
           "Err Desc: " &amp; Err.Description
    Err.Clear
End Sub