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
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