【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

     

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

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

     



    calendar

    S M T W T F S
       1234
    567891011
    12131415161718
    19202122232425
    2627282930  
    << November 2017 >>

    profile

    others

    mobile

    qrcode