Outlook: Sometimes a macro can be more efficient than a rule No ratings yet.

One of the useful features of Outlook is being able to create rules to organise your email.  In some cases, though, it may be a better approach to use a macro to process the email instead of a rule (assuming that you don’t mind dabbling in code, that is…).  A recent case highlighted this.  The case came in because a rule that ran a macro seemed to stop working sporadically.  We didn’t investigate the cause of this too deeply (it didn’t reproduce in my lab, and I couldn’t find any other reports of this happening, so it isn’t a common problem).  The macro in this case was to check all incoming email, and move email from a list of senders to a particular folder.  It was set up so that a rule would run the macro on every new message.

In this case, no rule is needed.  In fact, as the actual processing was done in a macro, it made perfect sense to implement everything in the macro.

Outlook VBA supports Outlook application events in the ThisOutlookSession module.  In fact, the Application events are exposed directly, you can just select Application from the object combobox and you’ll see all the exposed events in the method combobox (both these are above the code window, as shown below):

I’ve highlighted the Startup event for a reason – this is run every time Outlook loads.  This means that we can put code there to initialise our macro “rule” to ensure that it always runs, and we don’t need to do anything once it is set up.  In this case, the code that goes here hooks into another event (the Item_Add event for the Inbox folder) so that code is called every time a message arrives (or more accurately, every time a message is added to the Inbox – this would also trigger if you dragged or moved a message there).  In that event handler, the interesting code is placed (that actually checks the message and takes any action required).

The sample code below shows how you can check the source of an email (which domain it came from) and then assign a category based on that result (if the source domain is in the list, then it is categorised as Newsletter – otherwise it is left alone).  A useful function shows how to get the SMTP address of a sender from both internal and external contacts.  You can add to the domain list as needed, and in this sense is much more manageable than a rule (in fact, domain matching isn’t possible using rules) – the only thing to note is that you’d need to call InstantiateSenders once the list is updated for it to take effect.

Private Sub Application_Startup()
' We need to initialise our sender list - we only need to do this once
' We need to set our Inbox variable so that we can monitor events (i.e. to ensure that oInboxItems_ItemAdd is called
Set oInboxItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub oInboxItems_ItemAdd(ByVal item As Object)
' This event fires when a message is added to the inbox
If Left(item.MessageClass, 8) <> "IPM.Note" Then Exit Sub ' This is not an email, so ignore it
ProcessMail item
End Sub

Public Sub InstantiateSenders()
' Add any domains to match here
Set nlSenders = New Collection
With nlSenders
.Add "@domain1.com"
.Add "@domain2.com"
End With
End Sub

Private Function GetSenderSmtpAddress(item As Object)
Dim sSenderEmail As String

On Error Resume Next
sSenderEmail = ""
If item.SenderEmailType = "EX" Then
' We have an Exchanger sender, so need to retrieve the SMTP address
sSenderEmail = item.sender.GetExchangeUser.PrimarySmtpAddress
sSenderEmail = item.SenderEmailAddress
End If
If Err.Number <> 0 Then Err.Clear
GetSenderSmtpAddress = Trim(sSenderEmail)
On Error GoTo 0
End Function

Private Sub ProcessMail(item As MailItem)
Dim i As Integer
Dim pattern As String
Dim sender As String

sender = GetSenderSmtpAddress(item)
If (sender = "") Then Exit Sub

For i = 1 To nlSenders.Count
pattern = "*" & nlSenders(i) & "*"
If (sender Like pattern) Then
item.Categories = "Newsletters"
Exit Sub
End If
End Sub

Public Sub ProcessInbox()
Dim oItems As Outlook.Items
Dim i As Integer


Set oItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
For i = oItems.Count To 1 Step -1
If Left(oItems(i).MessageClass, 8) = "IPM.Note" Then ProcessMail oItems(i)
End Sub



Please rate this

Leave a Reply

Your email address will not be published. Required fields are marked *