ShellAndWait


Description:
This function mimics the VB Shell function, however it waits for the completion of the shelled function to finish, which can be very useful sometimes.
 
Code:
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal _
   hHandle As Long, ByVal dwMilliseconds 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
Private Declare Sub Sleep Lib "kernel32" (ByVal _
   dwMilliseconds As Long)

Private Const INFINITE = &HFFFF
Private Const SYNCHRONIZE = &H100000
Private Const WAIT_TIMEOUT = &H102

Public Sub ShellAndWait(PathName, Optional WindowStyle As _
   VbAppWinStyle = vbMinimizedFocus, Optional bDoEvents As _
   Boolean = False)

    Dim dwProcessID As Long
    Dim hProcess As Long
    
    dwProcessID = Shell(PathName, WindowStyle)
    
    If dwProcessID = 0 Then
        Exit Sub
    End If
    
    hProcess = OpenProcess(SYNCHRONIZE, False, dwProcessID)
    
    If hProcess = 0 Then
        Exit Sub
    End If
    
    If bDoEvents Then
        Do While WaitForSingleObject(hProcess, 100) = WAIT_TIMEOUT
            DoEvents
        Loop
    Else
        WaitForSingleObject hProcess, INFINITE
    End If
    
    CloseHandle hProcess
    
End Sub
 
Sample Usage:
 
    Dim nStart As Date
    nStart = Now

    ShellAndWait "notepad", vbNormalFocus, True
    
    MsgBox "You spent " & DateDiff("s", nStart, Now) & _
       " second(s) in notepad.", vbCritical