【VBA】起動したプログラムの終了を待つ(終了まで待機)

0

    <機能>
    (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

     

    よろしければポチッと押してください

    プログラマー ブログランキングへ

     



    selected entries

    categories

    calendar

    S M T W T F S
         12
    3456789
    10111213141516
    17181920212223
    24252627282930
    31      
    << March 2024 >>

    profile

    others

    archives