実行可能ファイルを起動し、終るのを待つ

どこから拾ってきたかは忘れたけど、Accessが１６ビットから３２ビットに変わった時「あせった」記憶がある。マ、実際に動いているので問題ないのであろう。

'履歴：H12.06.05 第2引数(WindowStyle)追加
'　　：H10.11.07 16ビット版を32ビット版へ
'　　：H09.07.01 初版
Option Compare Database
Option Explicit
Const MYObjName As String = "ML_wait_Shell32"
    'API宣言
Declare Function OpenProcess Lib "kernel32" (ByVal dwAccess As Long, ByVal lpCommandLine As Long, ByVal IDProcess As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal lpdExitCode As Long, hHandle As Long) As Long
Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    '定数宣言
Const PROCESS_QUERY_INFORMATION = &H400
Const STILL_ACTIVE = &H103

'概要：引数1でshellを実行し、終了を待つ。(wait_Shellの32ビット版)
Public Function Wait_Shell32(strCmdLine As String _
        , Optional intWindowStyle As Integer = vbNormalFocus) As Integer
On Error GoTo Err_wait_Shell32
Dim mbTitle As String
Dim hShell As Long
Dim hProc As Long
Dim lExit As Long
Dim bret As Long

    mbTitle = MYObjName & "/wait_Shell32"
    Wait_Shell32 = False
    hShell = Shell(strCmdLine, intWindowStyle)
    hProc = OpenProcess(PROCESS_QUERY_INFORMATION, False, hShell)
    Do
        GetExitCodeProcess hProc, lExit
        DoEvents
    Loop While lExit = STILL_ACTIVE
    bret = CloseHandle(hProc)
    Wait_Shell32 = True
    
Exit_wait_Shell32:
    Exit Function

Err_wait_Shell32:
    MsgBox Err.Number & "/" & Err.Description, vbCritical, mbTitle
    Resume Exit_wait_Shell32
End Function