Option Explicit

'//The Shell function runs other programs asynchronously so what
'//What you basically have to do is Open the existing Process
'//for the running Application and, LOOP & WAIT for the processes return state
'//ie when the specified process is in the signaled state
'//or a timeout occurs.

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 Declare Function CloseHandle Lib "kernel32" ( _
    ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
    ByVal hProcess As Long, _
    lpExitCode As Long) As Long

'&HFFFF
Private Const SYNCHRONIZE = &H100000
'// Note:SYNCHRONIZE Windows NT/2000
Private Const INFINITE = &HFFFF 'OR -1&
'// INFINITE, the functions time-out interval never elapses.
Private Const STILL_ACTIVE = &H103

Public Function ShellAndWait(ByVal BatFile As String)
   '
   ' Shells a new process and waits for it to complete.
   ' Calling application is totally non-responsive while
   ' new process executes.
   '
Dim pid As Long
Dim hProcess As Long
Dim nRet As Long

'// Unlike other Functions Shell generates an error
'// instead of returning a 0 so handling the error
'// = Application NOT started.
On Error Resume Next
pid = Shell(BatFile, vbMinimizedNoFocus)
If Err Then
    '// handle the error here and End
    MsgBox "Could NOT exercute:= " & BatFile
    End
End If
On Error GoTo 0

'// SYNCHRONIZE For Windows NT/2000:
'// Enables using the process handle in any of the wait
'// functions to wait for the process to terminate.
'// obviously with NT you need access rights.
hProcess = OpenProcess(SYNCHRONIZE, False, pid)
'// Just set the dwMilliseconds to INFINITE to initiate a Loop
nRet = WaitForSingleObject(hProcess, INFINITE)

Do
    GetExitCodeProcess hProcess, nRet
    DoEvents
Loop While nRet = STILL_ACTIVE

CloseHandle hProcess

End Function

Sub OpenFileAndWait()

Dim sApp As String 

'// Define the Application FullPath here
'sApp = "C:\A\Batch.bat"
'sApp = "C:\windows\system32\calc.exe"

sApp = "c:\windows\desktop\CreateAct\CreateActivity.pl"



'// Lets DoIt
ShellAndWait sApp

'// Tell me if Successful
MsgBox "Finished running task!"

End Sub



