ShellAndWait

Function ShellAndWait(PathName As String, _
Optional WS As VbAppWinStyle = vbMinimizedFocus) As Double
'

Dim lhProcess As Long
Dim lExitcode As Long
Dim dProcessID As Double
'

On Error GoTo errShellAndWait

dProcessID = Shell(PathName, WS)
lhProcess = OpenProcess(PROCESS_QUERY_INFORMATION, False, dProcessID)
Do
Call Sleep(50): DoEvents
Call GetExitCodeProcess(lhProcess, lExitcode)
Loop While (lExitcode = STILL_ACTIVE)
CloseHandle (lhProcess)
ShellAndWait = dProcessID

Exit Function

errShellAndWait:
If lhProcess <> 0 Then
CloseHandle (lhProcess)
End If
ShellAndWait = dProcessID
End Function