VBで別のプログラムを起動し他の処理を中断したい

VBプログラムの実行中に、shell("hoge.exe")で別のプログラムを起動しそのプログラムが終了すれば次の処理に移るという処理をしたいんですが、実現方法がわかりません。どうすればよいでしょうか？アドバイスよろしくお願いします。

No.3 ベストアンサー 回答者： maruru01 回答日時： 2002/09/19 09:30

こんにちは。

maruru01です。

別のAPIによる方法です。
WaitShellという関数を自作しました。
関数の引数には、Shell関数の引数をそのまま渡せばOKです。


***** API関数と定数の宣言 *****

'既存のプロセスオブジェクトのハンドルを返す関数
Public Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long

'OpenProcess関数の第1引数用の定数
Public Const PROCESS_QUERY_INFORMATION = &H400&

'指定されたプロセスの終了状態を返す関数
Public Declare Function GetExitCodeProcess Lib "kernel32" (ByVal hProcess As Long, lpExitCode As Long) As Long

'終了コードを示す定数
Public Const STATUS_PENDING = &H103&
Public Const STILL_ACTIVE = STATUS_PENDING

'オープンしているオブジェクトハンドルをクローズする関数
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

***** 関数 *****

'アプリケーションを起動し、終了するまで待機する
Public Sub WaitShell(AppPath As String, Optional SizeFocusmode As Integer = vbNormalFocus)

　　Dim AppID As Long　　'Shell関数の戻り値
　　Dim Process As Long　　'OpenProcess関数の戻り値
　　Dim ExitCode As Long　　'終了コード
　　Dim rc As Long

　　AppID = Shell(AppPath, SizeFocusmode)
　　Process = OpenProcess(PROCESS_QUERY_INFORMATION, 1, AppID)

　　'プロセスが終了していない間はDoEvents関数でOSに制御を戻す
　　Do
　　　　rc = GetExitCodeProcess(Process, ExitCode)
　　　　DoEvents
　　Loop While ExitCode = STILL_ACTIVE

　　rc = CloseHandle(Process)

End Sub

No.4 回答者： jincyan 回答日時： 2002/09/19 09:31

例えば下記で出来ます。

RETVAL = Shell(CTL_Edit_PATH, 1)
RETVAL2 = 0
Do While RETVAL2 = 0 '起動待ち
RETVAL2 = OpenProcess(&H400, Not 0, RETVAL)
DoEvents
Loop

lpExitCode = &H103
Do While lpExitCode = &H103　　　'終了待ち
RETVAL3 = GetExitCodeProcess(RETVAL2,lpExitCode)
DoEvents
Loop

No.2 回答者： sha-girl 回答日時： 2002/09/18 16:50

#1の方に補足です。

API ビューアだと
INFINITE が &HFFFFになっていますが
実際は INFINITE=&HFFFFFFFF
かと思います。
&HFFFFだと65秒でタイムアウトしませんか？

(実際確かめてないので自信はありません。間違ってたらごめんなさい。)

No.1 回答者： mfuku 回答日時： 2002/09/18 16:38

私が以前作成したEXEの同期起動プロシージャを提示します。

参考にして下さい（というよりそのまま使えると思います）。

下記のようにAPIを定義して
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

下記のプロシージャを定義して下さい。

Public Function pfncWaitApp(strExeName As String, Optional vntOpt As Variant) As Boolean
Dim lngResultCode As Long
Dim lngIdProcess As Long
Dim lngHdlProcess As Long
Dim intOpt As Integer
Const SYNCHRONIZE = &H100000
Const INFINITE = &HFFFF

If IsMissing(vntOpt) Then
intOpt = vbNormalFocus
Else
intOpt = vntOpt
End If

'EXE起動
On Error Resume Next
lngIdProcess = Shell(strExeName, intOpt)
DoEvents

Select Case Err
Case 53 'Not Found
MsgBox "指定されたプログラムが存在しません" & _
vbCr & "プログラム名 = " & strExeName, vbCritical
pfncWaitApp = False
Case 0 '正常
'同期をとる
lngHdlProcess = OpenProcess(SYNCHRONIZE, 0&, lngIdProcess)
lngResultCode = WaitForSingleObject(lngHdlProcess, INFINITE)
lngResultCode = CloseHandle(lngHdlProcess)
pfncWaitApp = True
Case Else 'エラー
MsgBox Error, vbCritical
pfncWaitApp = False
End Select


End Function

下記のように呼び出してください。
Call pfncWaitApp("hoge.exe")