еще работаю над проблемой, которую я описал в своем1-й вопрос по теме. Для краткого обновления, это файл Excel, который содержит список шаблонов электронной почты и вложений, к каждому блоку списка я добавляю кнопку, которая открывает шаблон блока подачи, вносит некоторые изменения, затем присоединяет файлы и отображает почту на Пользователь. Пользователь может изменить почту при необходимости, а затем отправлять или не отправлять почту. Я попробовал несколько подходов, описанных ниже. К сожалению, сейчас я застрял в проблеме с модулем класса, который кратко описанВот, Я создал модуль класса, например «EmailWatcher», и даже сделал небольшую комбинацию с описанным методом.Вот:

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

Изменение в следующую форму не вносит никаких изменений:

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

Код модуля выглядит следующим образом:

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

Наконец, я создал класс, который работает, и я поставил некоторые элементы управления, чтобы проверить его, как вы можете видеть из кода модуля класса. Но проблема в том, что он не перехватывает событие Send. Класс заканчивается в конце подпрограммы. Оставить письмо полностью пользователю. Вопрос в том, где ошибка? Или как оставить модуль класса в так называемом «режиме ожидания», или, может быть, есть другие предложения? Я также рассматриваю способ поиска писем в «исходящих» сообщениях, но подход с событием «Отправить» гораздо предпочтительнее.