Outlook NewEmailEx event won't fire in small VB6 application

I'm needing to run a small VB6 app that will sit in the system tray with the purpose of detecting specific incoming Outlook email messages and depending on the sender, subject and time of day, initiate a custom text page to various recipients spread out around the globe.

The only issue I've encountered is getting the NewEmailEx event to fire when the Outlook client receives a new email message. In addition to using VB6, I am also using Outlook 2010 and have a reference to the Microsoft Outlook 14.0 Object Library.

After spending a week plus searching and reading everything I could find on the subject, nothing I've tried thus far has been a success and the time has come to reach out for some assistance from the pro's (ie; RobDog888, koolsid and the like). If what I need to do as explained above is possible, any further information on the matter would be greatly appreciated.

In a small test project, I've finally got the following code but again, the NewEmailEx event never fires. Please excuse the bad formatting but I couldn't get proper indentions to retain.


Form1.frm
Option Explicit

Public myEmailMonitor As Class1

Private Sub Command1_Click()
Unload Me
End Sub

Public Sub Form_Initialize()
Set myEmailMonitor = New Class1
End Sub

Private Sub Form_Load()
Show
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
End
End Sub

Class1.cls
Option Explicit

Public WithEvents OutlookApplication As Outlook.Application

Sub Initialize_Handler()
Set OutlookApplication = Application
End Sub

Public Sub OutlookApplication_NewEmailEx(ByVal EntryIDCollection As String)
Dim objOutlookNameSpace As Outlook.NameSpace
Dim objOutlookMailApp As MailItem
Dim objOutlookMailItem As Outlook.MailItem
Dim strEntryIDValue() As String
Dim intEntryIDIndex As Integer

On Error Resume Next

Set objOutlookNameSpace = Application.Session

strEntryIDValue = Split(EntryIDCollection, ",")

For intEntryIDIndex = 0 To UBound(strEntryIDValue)
Set objOutlookMailApp = objOutlookNameSpace.GetItemFromID(strEntryIDValue(intEntryIDIndex))

If objOutlookMailApp.Class = olMail Then
Set objOutlookMailItem = objOutlookMailApp

Debug.Print Now & " " & objOutlookMailItem.Sender & " " & _
"(" & objOutlookMailItem.SenderName & ") " & _
"[" & objOutlookMailItem.SenderEmailAddress & "]"
Debug.Print Now & " " & objOutlookMailItem.Subject

Form1.List1.AddItem objOutlookMailItem.Sender
Form1.List2.AddItem objOutlookMailItem.SenderName
Form1.List3.AddItem objOutlookMailItem.SenderEmailAddress
Form1.List4.AddItem objOutlookMailItem.Subject
End If
Next

Set objOutlookNameSpace = Nothing
Set objOutlookMailApp = Nothing
Set objOutlookMailItem = Nothing
End Sub

Attached Files

• Class1.cls‎ (3.1 KB)
• Form1.frm‎ (4.3 KB)