Shell一个文件并等待完成

Option Explicit
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
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF
'auto sub
Private Sub ShellProgramAndWait(ProgramName As String)
Dim hHandle As Long, pid As Long
pid = Shell(ProgramName, vbNormalFocus)
If pid <> 0 Then
hHandle = OpenProcess(SYNCHRONIZE, 0&, pid)
WaitForSingleObject hHandle, INFINITE
Else
MsgBox "Error shelling " & ProgramName
End If
End Sub