Urgent - Detect Crash + Kill Program

[Nucleus]

You need to add code to restart outlook, but the code to close if the app is hung should work although untested, so you might have to fiddle. Also it assumes only one version of outlook at any one time.

Option Explicit
 
 
 
 
Private Declare Function FindWindow& Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String)
Private Declare Function SendMessageTimeout Lib "user32" Alias "SendMessageTimeoutA" (ByVal hwnd As Long, ByVal msg As Long, ByVal wParam As Long, ByVal lParam As Long, ByVal fuFlags As Long, ByVal uTimeout As Long, lpdwResult As Long) As Long
Private Const WM_NULL = &H0
Private Const SMTO_ABORTIFHUNG = &H2
 
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Const PROCESS_ALL_ACCESS = &H1F0FFF
 
Private Declare Function TerminateProcess& Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long)
Private Declare Function GetWindowThreadProcessId& Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
 
 
Sub RestartOutlookIfHung()
Dim lhwnd&, pid&, hp&
 
lhwnd = FindWindow("rctrl_renwnd32", vbNullString)
If (SendMessageTimeout(lhwnd, WM_NULL, 0, 0, SMTO_ABORTIFHUNG, 10, 0) = 0) Then
    GetWindowThreadProcessId lhwnd, pid
    hp = OpenProcess(PROCESS_ALL_ACCESS, 0&, pid)
    TerminateProcess hp&, 0&
    CloseHandle hp
End If
 
'You add code to restart outlook here
End Sub