| 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
|
| Dim nStart As Date
nStart = Now
ShellAndWait "notepad", vbNormalFocus, True
MsgBox "You spent " & DateDiff("s", nStart, Now) & _
" second(s) in notepad.", vbCritical
|