EXCEL VBA, Manual Outlook email sender, Class module Issue

Question

I am still working on the problem that I have described in my 1st question on this topic. For short refresh, it is an excel file which contains the list of email templates and attachments, to each list unit I have add the button which opens the template of the giving unit make there some changes, then attaches files and display the mail to the User. User can amend mail if necessary and then send or not to send mail. I have tried several approaches described below. Unfortunately, I am stalled now on the issue with class module, that shortly described here. I do have created a class module, such as 'EmailWatcher' and even make a small combination with method described here:

Option Explicit
Public WithEvents TheMail As Outlook.MailItem

Private Sub Class_Terminate()
Debug.Print "Terminate " & Now()  
End Sub

Public Sub INIT(x As Outlook.MailItem)
    Set TheMail = x
End Sub

Private Sub x_Send(Cancel As Boolean)
Debug.Print "Send " & Now()
ThisWorkbook.Worksheets(1).Range("J5") = Now()
'enter code here
End Sub

Private Sub Class_Initialize()
Debug.Print "Initialize " & Now()    
End Sub

The change to following form does not make any change:

Option Explicit
Public WithEvents TheMail As Outlook.MailItem
    
    Private Sub Class_Terminate()
    Debug.Print "Terminate " & Now()  
    End Sub

    Public Sub INIT(x As Outlook.MailItem)
        Set TheMail = x
    End Sub
    
    Private Sub TheMail_Send(Cancel As Boolean)
    Debug.Print "Send " & Now()
    ThisWorkbook.Worksheets(1).Range("J5") = Now()
    'enter code here
    End Sub
    
    Private Sub Class_Initialize()
    Debug.Print "Initialize " & Now()    
    End Sub

The module code is as follow:

Public Sub SendTo()
    Dim r, c As Integer
    Dim b As Object
    Set b = ActiveSheet.Buttons(Application.Caller)
    With b.TopLeftCell
        r = .Row
        c = .Column
    End With

    Dim filename As String, subject1 As String, path1, path2, wb As String
    Dim wbk As Workbook
    filename = ThisWorkbook.Worksheets(1).Cells(r, c + 5)
    path1 = Application.ThisWorkbook.Path & 
    ThisWorkbook.Worksheets(1).Range("F4")
    path2 = Application.ThisWorkbook.Path & 
    ThisWorkbook.Worksheets(1).Range("F6")
    wb = ThisWorkbook.Worksheets(1).Cells(r, c + 8)
    
    Dim outapp As Outlook.Application
    Dim oMail As Outlook.MailItem
    Set outapp = New Outlook.Application
    Set oMail = outapp.CreateItemFromTemplate(path1 & filename)

    subject1 = oMail.subject
    subject1 = Left(subject1, Len(subject1) - 10) & 
    Format(ThisWorkbook.Worksheets(1).Range("D7"), "DD/MM/YYYY")
    oMail.Display
    Dim CurrWatcher As EmailWatcher
    Set CurrWatcher = New EmailWatcher
    CurrWatcher.INIT oMail
    Set CurrWatcher.TheMail = oMail
    
    Set wbk = Workbooks.Open(filename:=path2 & wb)
    
    wbk.Worksheets(1).Range("I4") = 
    ThisWorkbook.Worksheets(1).Range("D7").Value
    wbk.Close True
    ThisWorkbook.Worksheets(1).Cells(r, c + 4) = subject1
    With oMail
        .subject = subject1
        .Attachments.Add (path2 & wb)
    End With
    With ThisWorkbook.Worksheets(1).Cells(r, c - 2)
        .Value = Now
        .Font.Color = vbWhite
    End With
    With ThisWorkbook.Worksheets(1).Cells(r, c - 1)
        .Value = "Was opened"
        .Select
    End With       
End Sub

Finally I have made a class which is working and I have put some controls to check it as you can see from class module code. But the problem is, it does not catch the Send event. The class is terminating at the end of the sub. Leaving the email fully to User. The question is: where is mistake? Or how to leave the class module in so called "waiting mode", or maybe any other suggestions? I so also consider the way to search for mails in the 'outbox' but the approach with Send event is much more in favour.

Answer 1

Dim CurrWatcher As EmailWatcher

This line needs to be global, outside of any subroutines.