Search code examples
vbaoutlookms-officeoffice-2007outlook-2007

VBA Outlook Mail .display, recording when/if sent manually


My code displays a message with basic subject, body, attachment. Next the user manually updates and customizes the message and should send it. I want to record when (if) the email is sent. Is this possible or any tips?

My environment is Office 2007 with an excel based macro going to Outlook.

[Excerpt]

Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon

Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
    .To = Email                 '.CC = 
    .Subject = Subj
    .BodyFormat = olFormatHTML
    .Body = Msg                 '.HTMLBody = Msg
    If Not FileAttach = vbNullString Then .Attachments.Add (FileAttach) 
    .Display
End With

Solution

  • This is entirely possible, using the _Send event in the Outlook.MailItem class.

    The way I use it, I create a class called EMail Watcher, so when I create the email and do the .Display, I then create a new EMailWatcher object and tell it to watch that email for send, then report back when it happens.

    Here's the class as I use it. Basically, I also optionally can set the BoolRange so that if the user sends the email, that Excel range gets updated with True. I can also have the class update an Excel range with the time the email is sent.

    Public BoolRange As Range
    Public DateRange As Range
    Public WithEvents TheMail As Outlook.MailItem
    
    
    Private Sub TheMail_Send(Cancel As Boolean)
        If Not BoolRange Is Nothing Then
            BoolRange.Value = True
        End If
        If Not DateRange Is Nothing Then
            DateRange.Value = Now()
        End If
    End Sub
    

    And here's how I use it:

    With oMail
        .To = addr
        .Subject = "CCAT eVSM Utilities License Code"
        .Body = "Message body"
        .Display
    End With
    Set CurrWatcher = New EmailWatcher
    Set CurrWatcher.BoolRange = Range("G12")
    Set CurrWatcher.TheMail = oMail
    

    Hopefully that helps...