'这个问题以前讨论过,但是解决方案有一个小小的缺陷, 就是主程序不能刷新.Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFFFFFF
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 Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long
Private Sub Command1_Click()
    Dim pId As Long, pHnd As Long
    Const PROCESS_ALL_ACCESS = 0
    pId = Shell("Notepad", vbNormalFocus)  '现在用的是记事本
    
    Do While IsActive(pId)
        DoEvents
    Loop
    
    '调用的程序结束时,程序从下面一行继续运行
    pHnd = OpenProcess(PROCESS_ALL_ACCESS, False, pId)
    If pHnd <> 0 Then
        Call WaitForSingleObject(pHnd, INFINITE)
        Call CloseHandle(pHnd)
    End If
    Beep
End Sub
Private Function IsActive(hprog) As Long
    Dim hProc, RetVal As Long
    Const PROCESS_QUERY_INFORMATION = &H400
    Const STILL_ACTIVE = 259
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hprog)
    If hProc <> 0 Then
        GetExitCodeProcess hProc, RetVal
    End If
    IsActive = (RetVal = STILL_ACTIVE)
    CloseHandle hProc
End Function