Check to see if an Outlook Email was sent from Excel VBA

[Joe_Canadian]

I have a macro that opens and populates an Outlook Email, and displays it for editing. What I would like to do is have a way to determine if the user has sent it or not, and have some code run if they closed the email instead of sending it.

Public Sub SendNotification()
Call AsgVar 'Routine which declares and intializes common variables
Dim strTMP As String, sTo As Variant, sCC As String, sBCC As String, sSubject As String, strbody As String
 
Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)
    On Error GoTo Error_Handler
 
[Bunch of code assigning values to all of the strings]
 
            With OutMail
                .To = sTo
                .CC = sCC
                .BCC = sBCC
                .Subject = sSubject
                .Body = strbody
                .Attachments.Add "C:\BATTERY_ANALYSIS\" & strFileName
                If Not (ReplaceSheet = False Or ReplaceSheet = Null)Then .Attachments.Add RepDoc
                .Display
            End With
 
            Set OutMail = Nothing
            Set OutApp = Nothing
 
 
If user hit red close button instead of send then
 
     [code to run]
Else
    MsgBox ("Notification sent to " & strPlannerEmail & "@company.com")
End If
 
[different unrelated code]
 
end sub

Basically how do I do the bold line?

 

[RoryA]

Add a class module (called CMailItemEvents) to your project with this code:

Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Close(Cancel As Boolean)
   Dim blnSent As Boolean
   On Error Resume Next
   blnSent = itm.Sent
   If Err.Number = 0 Then
      Debug.Print "not sent"
   Else
      ' do what you need to do
   End If
End Sub

adjusting the procedure as required.
Then amend your module so that you have this declaration at the top of the module:

Dim itmevt As New CMailItemEvents

and add a line to the calling routine so it reads:

    Set outmail = OutApp.CreateItem(0)
    Set itmevt.itm = outmail

HTH

 

[Joe_Canadian]

With the added note that it requires the Outlook library reference to run, works well.


Thanks Rory

 

[RoryA]

Yes - I should have mentioned that, sorry. You can't declare an Object variable WithEvents so late binding is impossible.

 

[Sgdva]

Add a class module (called CMailItemEvents) to your project with this code:

Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Close(Cancel As Boolean)
   Dim blnSent As Boolean
   On Error Resume Next
   blnSent = itm.Sent
   If Err.Number = 0 Then
      Debug.Print "not sent"
   Else
      ' do what you need to do
   End If
End Sub

adjusting the procedure as required.
Then amend your module so that you have this declaration at the top of the module:

Dim itmevt As New CMailItemEvents

and add a line to the calling routine so it reads:

    Set outmail = OutApp.CreateItem(0)
    Set itmevt.itm = outmail

HTH

Sorry to revive an old post, but, I've found that this is kind of what I need, though, when I close the Email nothing is logged
Here's the calling routine

Dim itmevt As New CMailItemEvents
Sub SendWithAtt2()
    Dim olApp As Object
  Dim olMail As MailItem
    Dim CurrFile As String
    Set olApp = CreateObject("Outlook.Application")
    Set olMail = olApp.CreateItem(olMailItem)
    Set outmail = olMail
    Set itmevt.itm = outmail
    
    ActiveWorkbook.Save
    CurrFile = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
    With olMail
        .To = "[EMAIL="name@domain.net"]name@domain.net[/EMAIL]"
        .CC = "[EMAIL="name2@domain2.com"]name2@domain2.com[/EMAIL]"
        .Subject = "These two files"
        .Body = ActiveSheet.Range("D4").Text & vbCrLf
        .Attachments.Add CurrFile
        .Display '.Send
        
        
    End With
    Set olMail = Nothing
    Set olApp = Nothing
End Sub

 

[bradyboyy88]

Add a class module (called CMailItemEvents) to your project with this code:

Option Explicit
Public WithEvents itm As Outlook.MailItem
Private Sub itm_Close(Cancel As Boolean)
   Dim blnSent As Boolean
   On Error Resume Next
   blnSent = itm.Sent
   If Err.Number = 0 Then
      Debug.Print "not sent"
   Else
      ' do what you need to do
   End If
End Sub

adjusting the procedure as required.
Then amend your module so that you have this declaration at the top of the module:

Dim itmevt As New CMailItemEvents

and add a line to the calling routine so it reads:

    Set outmail = OutApp.CreateItem(0)
    Set itmevt.itm = outmail

HTH

Rory,
Why would Err.Number=0 mean that email was not sent? I thought Err.Number=0 means there was no error hence it was most likely sent?

 

[bradyboyy88]

Also, blnSent = itm.Sent always seems to return false.

 

[RoryA]

Rory,
Why would Err.Number=0 mean that email was not sent? I thought Err.Number=0 means there was no error hence it was most likely sent?

It does - the Debug statement is incorrect.

 

[bradyboyy88]

Okay , I was very confused because I am using this code also now. Also, why does blnSent = itm.Sen always return false even if the email was sent? Is it because its asking to early? I think the send event is before actually sending hence the cancel parameter allows you to cancel sending.

 

[RoryA]

The code is using the Close event, not the Send event.