VBA Outlook Mail .display, recording if sent manua

Question

I'm sending emails from Excel using VBA, and having a very hard time of attempting to record whether the message has been sent or not. I have taken some code from another post on here:

Link

I have created the class exactly as described, and put in a few extra bits to see if it is working, it initializes, but then nothing else happens - even after the mail is sent, the class remains open in the background somehow, so I have to stop it in the VBE.

Here is the calling code:

Sub SendProc2(add As String)

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

On Error Resume Next

With OutMail
    .To = add
    .CC = ""
    .BCC = ""
    .Subject = ThisWorkbook.Name
    .Body = Application.WorksheetFunction.VLookup(Worksheets("Data").Range("B135"), Range("formversion"), 2, False) _
    & " Attached:" & vbCrLf & vbCrLf & ThisWorkbook.Name
    .Attachments.add ActiveWorkbook.FullName
    .Display   'or use .Send
End With

Dim CurrWatcher As EmailWatcher
Set CurrWatcher = New EmailWatcher
Set CurrWatcher.TheMail = OutMail

On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

Unload UserForm4

End Sub

and here is the Class Module Code which is called EmailWatcher:

Option Explicit
Public WithEvents TheMail As Outlook.MailItem

Private Sub Class_Terminate()

Debug.Print "Terminate " & Now()

End Sub

Private Sub TheMail_Send(Cancel As Boolean)

Debug.Print "Send " & Now()
'enter code here

End Sub

Private Sub Class_Initialize()

Debug.Print "Initialize " & Now()

End Sub

It never seems to register the _Send, which I think might be something to do with the class object not being defined or something else, I've had loads of trouble with this, sometimes I get warnings, at the moment it is Initializing, then Terminating immediately without waiting for the _Send, Help would be appreciated, and also if any more information is needed then let me know.

Using Excel 2007, on Windows 7, over a crazy local authority network that I have no control over.

I'm also not new to VBA, but I've never done classes before, done lots of standard modules etc.

Thanks,

Dan

Answer 1

Class

Private WithEvents EM As Outlook.MailItem

Public Sub INIT(x As Outlook.MailItem)
    Set EM = x
End Sub

Private Sub EM_Send(Cancel As Boolean)

End Sub

Module

Public WATCHER As clsEmailWatch

Sub EMAIL()

Dim o As Outlook.Application
Dim m As Outlook.MailItem

Set o = New Outlook.Application
Set m = o.CreateItem(olMailItem)

Set WATCHER = New clsEmailWatch
WATCHER.INIT m

m.To = "[e-mail]"

m.Send

End Sub

Hope this helps

Answer 2

This looks like it has something todo with displaying mails while a userform is running.

I had the same problem that, while a userform exists, the Outlook events didn't register. To fix the problem I implemented kind of a hack:

You need a boolean property in your class or userform module:

Private someBool as Boolean

And you need to subscribe to the MailItem.Close Event and set the new boolean:

Private Sub TheMail_Close(Cancel As Boolean)
    someBool = True
End Sub

This event is raised when the displayed E-Mail is closed, sent or saved.

Then you obviously need a Property Get method:

Public Property Get MailClosed() As Boolean
    MailClosed = someBool
End Property

And now, to handle all the Events, you need a Loop in the module where you Display your mail from:

[...]
Dim CurrWatcher As EmailWatcher
Set CurrWatcher = New EmailWatcher
Set CurrWatcher.TheMail = OutMail

Do Until CurrWatcher.MailClosed
    DoEvents
Loop

[...]

I am not certain why DoEvents works, if someone could shed some light on it I'll add it to my answer.