Parsing All Emails

Guy

Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
I have an Outlook client that is always running, on a machine always logged in. It uses a special email address and it's not a person. We use this email as a "traffic cop" that captures inbound mail from disparate business systems inside the building and then through VBA executes certain procedures, for example it will read the incoming mail and based on the subject go off in one case write an XML file to disk on a remote server that will be absorbed into another business system. We use the client as "glue" for integrating these systems. So far so good.

I have one routine that reads all inbound emails and then based on subject line (or lack of) content branches the action to take. I have in this routine a For Each (For Each InboxItem In olFolder.Items) statement that picks through the subject line. My question is will this routine look at multiple simultaneously received emails one after the other? I cannot easily test this scenario and want to make the tool robust. Does the For Each InboxItem step through one new email and then the next or will it just do the first one? Is there a better way to do what I am attempting here? I trigger this routine via a call from ThisOutlookSession using Sub Application_NewMail. Any insights here would be most appreciated.
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
For each will run through all messages in the folder. Not a problem if you move the messages out after processing (you'll only have new messages in the inbox), but is a problem if you have 100's of messages.

You want to use newmail or item add to process the current message. Hand it off to another macro to finish processing if you can - use

sub processmail(ByVal Item As Object)
' do whatever
if item.subject = "Howdy" then
end if
end sub

BTW, newmail is better than itemadd if the messages are coming in fast - if a large number of items are added to a folder at that same time, the ItemAdd event may not fire.
 

Guy

Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Thanks Diane, this helped a lot. I did fail to mention that the email frequency will be quite low. 5 per day max. Maybe 2 at once per server request kind of thing. Really like this forum - it has been a huge help over the years!
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
That is definitely slow enough for itemadd, but if newmail is working, no need to break what isn't broke. :) But, even with low volume, there can be benefit to handing the message off to a separate macro to process. If you are looking at multiple conditions and actions, the newmail macro can use if statements and push off to different macros. This can make it easier to troubleshoot if you need to edit or think there is a bug.
 

Guy

Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Thanks again Diane.

This all seems to be working nicely, however there is one spot that I find very odd that I have had to put into the code and that is getting the body text. If I don't display the email (InboxItem.Dsplay) and then pause the routine (Pause 1) VBA seems to "miss" the BodyText=InboxItem.Body call. The variable ends up empty if I remove these. I have to believe there is a better way than showing an email and pausing. Seems arcane to me. Thoughts? Other than that, this all seems to work quite nicely.

So here is my code basics for this:

Private Sub Application_NewMail()
Call ReadNewEMail
Call EmptyTrash
End Sub

Sub ReadNewEMail()

Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim TEAMParsed As Outlook.folder
Dim FailedSubjectLine As Outlook.folder
Dim InboxItem As Object
Dim TrashBox As Object
Dim NoECONumber As Object
Dim WorkReqType As String

Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = GetFolder("\\TEAM\Inbox")
Set TEAMParsed = olFolder.Folders("Parsed")
Set FailedSubjectLine = olFolder.Folders("Trash")
Set NoECONumber = olFolder.Folders("No ECO Number")

For Each InboxItem In olFolder.Items

strID = InboxItem.EntryID
Set InboxItem = Application.Session.GetItemFromID(strID)
InboxItem.Display 'DISPLAY EMAIL TO ALLOW CAPTURING BODY TEXT
Pause 1
BodyText = InboxItem.Body
InboxItem.Close olSave
SubjectLineText = InboxItem.Subject
EmailType = Left(SubjectLineText, 9)


Select Case EmailType 'I use this as the branching method to go off to other routines based on email subject line
 

Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
This is kind of what you need to be doing:
Private Sub Application_Startup()
Dim objMyInbox As Outlook.MAPIFolder

Set objNS = Application.GetNamespace("MAPI")
Set objMyInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objNewMailItems = objMyInbox.Items
Set objMyInbox = Nothing
End Sub


Private Sub objNewMailItems_ItemAdd(ByVal Item As Object)
'Ensure we are only working with e-mail items
If Item.Class <> olMail Then Exit Sub

Debug.Print "Message subject: " & Item .Subject
Debug.Print "Message sender: " & Item .SenderName & " (" & Item .SenderEmailAddress & ")";

ReadNewEMail item
EmptyTrash item

End Sub


Sub ReadNewEMail(ByVal Item As Object)

Dim olApp As Outlook.Application
Dim objNS As Outlook.NameSpace
Dim olFolder As Outlook.MAPIFolder
Dim TEAMParsed As Outlook.folder
Dim FailedSubjectLine As Outlook.folder
Dim Item As Object
Dim TrashBox As Object
Dim NoECONumber As Object
Dim WorkReqType As String

Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")

' these can be set in the startup folder instead although with only a couple of messages per day being processed, it really doesnt matter
Set olFolder = GetFolder("\\TEAM\Inbox")
Set TEAMParsed = olFolder.Folders("Parsed")
Set FailedSubjectLine = olFolder.Folders("Trash")
Set NoECONumber = olFolder.Folders("No ECO Number")

strID = Item.EntryID
Item.Display 'DISPLAY EMAIL TO ALLOW CAPTURING BODY TEXT
Pause 1
BodyText = Item.Body
Item.Close olSave
SubjectLineText = Item.Subject
EmailType = Left(SubjectLineText, 9)
' reset of code


Using the newmailex method, you'd do something like this instead of the itemadd method -

Private Sub Application_NewMailEx(ByVal EntryIDCollection As
String)
Dim objNS As Outlook.NameSpace
Dim objEmail As Outlook.MailItem
Dim strIDs() As String
Dim intX As Integer
strIDs = Split(EntryIDCollection, ",")
For intX = 0 To UBound(strIDs)
Set objNS = Application.GetNamespace("MAPI")
Set objEmail = objNS.GetItemFromID(strIDs(intX))
Debug.Print "Message subject: " & objEmail.Subject
Debug.Print "Message sender:" & objEmail.SenderName &" (" & objEmail.SenderEmailAddress & ")"

ReadNewEMail objEmail
EmptyTrash objEmail

Next


Set objEmail = Nothing
End Sub
 

Guy

Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Awesome! I knew there had to be a better way. Terrific. Thank you.
 

Guy

Member
Outlook version
Outlook 2016 32 bit
Email Account
Exchange Server
Diane, thank you very much. I have made adjustsment per your suggestions and it runs perfectly. I have also read through your suggested readings. Very helpful and informative. Much appreciated.
 
Top