EXCEL VBA, remetente manual do email do Outlook, edição do módulo de classe

Ainda estou trabalhando no problema que descrevi no meu1ª questão neste tópico. Para uma breve atualização, é um arquivo do Excel que contém a lista de modelos e anexos de email. Em cada unidade de lista, adiciono o botão que abre o modelo da unidade fornecedora, faz algumas alterações, anexa os arquivos e exibe o correio para o Do utilizador. O usuário pode alterar o correio, se necessário, e depois enviar ou não o envio. Eu tentei várias abordagens descritas abaixo. Infelizmente, agora estou parado no problema com o módulo de classe, que brevemente descreveuaqui. Eu criei um módulo de classe, como 'EmailWatcher' e até faço uma pequena combinação com o método descritoaqui:

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

A alteração no seguinte formulário não faz nenhuma alteração:

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

O código do módulo é o seguinte:

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

Finalmente, criei uma classe que está funcionando e coloquei alguns controles para verificá-la como você pode ver no código do módulo de classe. Mas o problema é que ele não captura o evento Send. A classe está terminando no final do sub. Deixando o email totalmente para o Usuário. A questão é: onde está o erro? Ou como deixar o módulo de classe no chamado "modo de espera" ou talvez outras sugestões? Também considero a maneira de procurar e-mails na 'caixa de saída', mas a abordagem com o evento Enviar é muito mais favorável.

questionAnswers(3)

yourAnswerToTheQuestion