Capturing Outlook Email Send Time In Excel VBA

Question

An Outlook email is generated whenever I execute a VBA code in Excel. It does not automatically send, nor do I want it to. The email is populated by cell values in a range (which are based off of the ActiveCell) and into ActiveCell.Offset(0, 13), preferably with VBA in my current Excel program. 到ActiveCell.Offset（0，13），最好在当前的Excel程序中使用VBA。

This is the code by which I display the email:

'Send Stock Request:
Dim OutApp As Object
Dim OutMail As Object

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
    .BodyFormat = olFormatHTML
    .HTMLBody = "My eMail's HTML Body"
    .To = "myrecipients@theiremails.com"
    .CC = ""
    .BCC = ""
    .Subject = "Stock Request"
    .Display
End With

Set OutMail = Nothing
Set OutApp = Nothing

Answer 1

It can be done through VBA, but code below must be pasted in Outlook module instead of Excel, in Outlook => ThisOutlookSession module. Also, make sure you allow macros in Outlook.

Private Sub Application_ItemSend(ByVal olItem As Object, Cancel As Boolean)

Dim Xl As Object ' Excel.Application
Dim Wb As Object ' Excel.Workbook
Set Xl = GetObject(, "excel.application")
Set Wb = Xl.Workbooks("NameOfYourOpenedWorkbook.xlsb")
Wb.Activate
Xl.activecell.Offset(0, 13).Value = Date & " " & Time

End Sub

So now when you send your automatically created email manually, you will get date and time captured in your opened Workbook in ActiveCell.Offset(0, 13) cell.

Answer 2

Add a VBA project reference to the Outlook object model, and add this class to your excel file:

''clsMail
Option Explicit

Public WithEvents itm As Outlook.MailItem
Public DestCell As Range '<< where to put the "sent" message
'you can add other fields here if you need (eg) to 
'  preserve some other info to act on when the mail is sent

Private Sub itm_Send(Cancel As Boolean)
    Debug.Print "Sending mail with subject: '" & itm.Subject & "'"
    DestCell.Value = "Mail sent!"  '<< record the mail was sent
End Sub

Then in your Mail-sending code you can do something like this:

Option Explicit

Dim colMails As New Collection

Sub Tester()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim obj As clsMail

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    With OutMail
       .BodyFormat = olFormatHTML
       .HTMLBody = "My eMail's HTML Body"
       .To = "twilliams@theravance.com"
        .CC = ""
        .BCC = ""
        .Subject = "Stock Request"
        .Display
    End With
    'create an instance of the class and add it to the global collection colMails
    Set obj = New clsMail
    Set obj.itm = OutMail
    Set obj.DestCell = ActiveCell.Offset(0, 13) '<< "sent" flag goes here
                                                ' when the user sends the mail
    colMails.Add obj

End Sub