【VBA】起動したプログラムの終了を待つ(終了まで待機)
<機能>
(1)Shellでペイントを起動し、終了まで待ちます
(2)OpenProcessで起動したプログラムのハンドルを取得します
(3)GetExitCodeProcessで終了ステータスを監視します
※本サンプル以外にもCreateProcessやShellExecuteEXで起動してWaitForSingleObjectで待つ方法があります
<動作検証&開発環境>
Microsoft Office 2010
<使い方>
適当なところにソースを張り付けて「アプリケーションの終了を待つ()」を呼び出してください
<その他>
OpenProcessの第1引数については下記を参照してください
https://msdn.microsoft.com/ja-jp/library/cc429278.aspx
'//DLLの参照を宣言
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwAccess As Long, ByVal fInherit As Long, _
ByVal IDProcess As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function GetExitCodeProcess Lib "kernel32" ( _
ByVal hProcess As Long, ByRef lpdwExitCode As Long) As Long
'//定数定義
Private Const PROCESS_QUERY_INFORMATION = &H400&
Private Const STILL_ACTIVE = &H103&
'********************************************
'アプリケーションの終了を待ちます
'ペイント(mspaint.exe)を終了させるとメッセージを出力します
'********************************************
Sub アプリケーションの終了を待つ()
Dim lProcessID As Long, hProcess As Long
Dim dwExitcode As Long
Dim lret As Long
'//アプリケーションの起動
'//Shellの第1引数で指定したプログラムが存在しないときの実行エラーを回避してエラーメッセージを出力する
On Error Resume Next
lProcessID = Shell("mspaint", vbNormalFocus)
If Err <> 0 Then
'実行ファイルが存在しない時はエラーメッセージを出力する
MsgBox "プログラムの起動エラーです(Shell)", vbExclamation
Exit Sub
End If
On Error GoTo 0
'//実行したプログラムのプロセスハンドルを取得
'//PROCESS_QUERY_INFORMATION:GetExitCodeProcess関数がこのプロセスのハンドルを使うことを認める
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION, 1, lProcessID)
'//何らかの理由でプロセスハンドル取得でエラーが発生した
If hProcess = 0 Then
'VBAを起動しているエクセルをアクティブにする
AppActivate Application.Caption
MsgBox "プログラムのプロセスハンドル取得エラーです(OpenProcess)", vbExclamation
Exit Sub
End If
'//終了ステータス(dwExitcode)の監視
'//対象プログラムが実行中のとき終了ステータスはSTILL_ACTIVE(&H103)
Do
'オペレーティングシステムに制御を渡す
DoEvents
'プロセスの終了ステータスを取得
lret = GetExitCodeProcess(hProcess, dwExitcode)
'何らかの理由でGetExitCodeProcessが失敗した
If lret = 0 Then
CloseHandle hProcess
MsgBox "プログラムの終了ステータス取得エラーです(GetExitCodeProcess)", vbExclamation
Exit Sub
End If
Loop While (dwExitcode = STILL_ACTIVE)
'//終了後の処理
MsgBox "mspaintは正常に終了しました", vbInformation
End Sub
よろしければポチッと押してください