タイムアウトしたアプリを閉じる方法

Option Explicit

Private Declare Function OpenProcess Lib "kernel32.dll" ( _
  ByVal dwAccess As Long, _
  ByVal fInherit As Integer, _
  ByVal hObject As Long _
  ) As Long

Private Declare Function WaitForSingleObject Lib "Kernel32" ( _
  ByVal hHandle As Long, _
  ByVal dwMilliseconds As Long _
  ) As Long

Private Declare Function TerminateProcess Lib "kernel32" ( _
  ByVal hProcess As Long, _
  ByVal uExitCode As Long _
  ) As Long

Private Declare Function CloseHandle Lib "kernel32" ( _
  ByVal hObject As Long _
  ) As Long
  
Const SYNCHRONIZE = 1048576
Const WAIT_TIMEOUT = 258
Const PROCESS_TERMINATE = &H1

Private Sub Main()

    Dim ProcessID     As Long
    Dim ProcessHandle As Long
    Dim Ret           As Long

    ProcessID = Shell("notepad.exe", vbNormalNoFocus)

    ProcessHandle = OpenProcess(SYNCHRONIZE, True, ProcessID)
    
    Ret = WaitForSingleObject(ProcessHandle, 5000)
    
    Call CloseHandle(ProcessHandle)
    ProcessHandle = OpenProcess(PROCESS_TERMINATE, True, ProcessID)
    
    Call TerminateProcess(ProcessHandle, 0&)
    Call CloseHandle(ProcessHandle)
    
    If Ret = WAIT_TIMEOUT Then Debug.Print "タイムアウト！"

End Sub

OpenProcess の第1引数を変えて、ハンドルを開きなおす必要があるところでちょっと躓いたのでメモしておく。

参考にしたページ

第1回 Windowsのプロセスを詳しく探る | 日経 xTECH（クロステック）