Запуск макроса при создании нового письма

'Outlook(32bit) CreationMailEvent (Событие создания письма), by testuser, 10.05.2023
'Код следует поместить в стандартный модуль
'В событие Application_Startup следует поместить вызов Hook
'В событие Application_Quit поместить вызов UnHook
 
Option Explicit
 
Private Declare Function CallNextHookEx Lib "USER32" (ByVal hHook As Long, ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long
Private Declare Function SetWindowsHookEx Lib "USER32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long
Private Declare Function UnhookWindowsHookEx Lib "USER32" (ByVal hHook As Long) As Long
Private Declare Function GetClassName Lib "USER32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "USER32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function SetTimer Lib "USER32" (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "USER32" (ByVal hwnd As Long, ByVal nIDEvent As Long) As Long
 
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HCBT_CREATEWND As Long = 3
Private Const HC_ACTION = 0
Private hHook As Long
 
Private Function NewProc(ByVal lngCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Dim className$, windTitle$, lngBuffer&, RetVal&
    
    Const sclass$ = "rctrl_renwnd32"
    Const swndttl$ = "Без имени - Сообщение" '"Без имени - Сообщение (HTML)"
    
    If lngCode < HC_ACTION Then
        NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam)
        Exit Function
    End If
        
    If lngCode = HCBT_ACTIVATE Then
        lngBuffer& = 255
        className$ = String$(256, " ")
        windTitle$ = String$(256, " ")
        RetVal = GetClassName(wParam, className, lngBuffer)
        className = Left$(className, RetVal)
        If className = sclass Then
            RetVal = GetWindowText(wParam, windTitle, lngBuffer)
            windTitle = Left$(windTitle, RetVal)
            If InStr(1, windTitle, swndttl, 1) Then 'If windTitle = swndttl Then
                
                SetTimer 0, 0, 700, AddressOf CreationMaylEvent 'отсрочка 700 мс (0,7 сек)
                
            End If
        End If
          
    End If
 
    CallNextHookEx hHook, lngCode, wParam, lParam
End Function
 
Public Sub Hook()
    hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, GetModuleHandle(vbNullString), GetCurrentThreadId)
End Sub
 
Public Sub UnHook()
    UnhookWindowsHookEx hHook
End Sub
 
Private Sub CreationMaylEvent(ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As Long)
    KillTimer 0, uElapse
    
    MsgBox "Вы создаете новое письмо!!!", vbInformation + vbSystemModal, "Внимание!"
    
End Sub