# Replace many Outlook email rules with a script

I as well as several of my colleagues have had an ongoing problem where we get bombarded with hundreds if not thousands of emails each day which come from automated services, such as SQL DBmail and other similar mechanisms. Many of these notifications are not really important to look at, and they are almost always sent to large mailing lists. A bit like this... ;-)

Many of us have so many Outlook rules that we have exceeded the maximum amount of rules permitted. Running all those rules on all incoming mail is slow and can bog down Outlook. So I have decided to write this script which can be ran as the top-most rule and will allow us to turn off most of the other rules. I tested it and it works good, and is way faster than having so many rules.

I have written comments throughout to help my colleagues edit the script for their own needs (e.g. different folder names, or slightly different filtering criteria). I have formatted it in such a way that hopefully will look familiar to a user whose primary familiarity is with SQL.

I don't write VBA very often, and this is my first Outlook VBA attempt, so I would like to improve it in any way possible. Here is the code, keep in mind everything is contained in the same module.

'Make all text matching case-Insensitive
'To make case-Sensitive change to: Option Compare Binary
Option Compare Text
'No implicit variables allowed:
Option Explicit

Sub FilterMailItems(item As Outlook.mailItem)
'This is to be used largely for notifications from SQL and other
'automated notifications, which notifications are not necessarily important
'to look at in the immediate and can be archived.

Dim recip As Recipient
For Each recip In item.Recipients
'Filter for RECIPIENTS (e.g. mailing group)
If ( _
InStr(recip.Name, "intdev") > 0 _
) _
Then
'Filter for SENDER:
If ( _
InStr(item.SenderName, "SQLAdmin") > 0 _
Or InStr(item.SenderName, "intdev") > 0 _
) _
Then
'Exceptions to NOT handle and skip:
'IMPORTANT: use the Not operator!
If ( _
Not InStr(item.Subject, "Supplies") > 0 _
And Not InStr(item.Subject, "Referral") > 0 _
) _
Then
'Filters for MISC items:
'NOTE: use as precise of a match as possible to make this work best:
If ( _
InStr(item.Subject, "QueryDatabases") > 0 _
Or InStr(item.Subject, "has processed a file") > 0 _
Or InStr(item.Subject, "Transaction Cleanup") > 0 _
) _
Then
'Folder to move MISC items to:
'Filters for ERROR items:
ElseIf ( _
InStr(item.Subject, "error") > 0 _
Or InStr(item.Subject, "exception") > 0 _
Or InStr(item.Subject, "failure") > 0 _
) _
Then
'Folder to move ERROR items to:
End If
'If not matching any above conditions, then leave alone
End If
End If
End If
Next recip

End Sub

Private Function MarkReadAndMoveToFolder(item As Outlook.mailItem, destination As String) As Boolean
'Set up Outlook application and inbox variables
Dim nameSpace As Outlook.nameSpace
Dim inbox As Outlook.Folder
Dim destFolder As Outlook.Folder
Set nameSpace = Application.GetNamespace("MAPI")
Set inbox = nameSpace.GetDefaultFolder(olFolderInbox)
Set destFolder = inbox.Folders(destination)

'Mark as read and move to destination folder in inbox
item.Move destFolder
End Function


Here's some changes I would make.

First thing I would do is make most of this module level variables, initialized in your Application_startup method, and taking advantage of WithEvents to setup the listener.

Option Explicit

Private nameSpace As Outlook.nameSpace
Private inbox As Outlook.Folder
Private destFolder As Outlook.Folder

Private WithEvents items As Outlook.items

Private Sub Application_Startup()
Set nameSpace = Application.GetNamespace("MAPI")
Set inbox = nameSpace.GetDefaultFolder(olFolderInbox)
Set destFolder = inbox.Folders(destination)

'set this to listen for events on your inbox
Set items = Application.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderInbox) _
.items
End Sub


Then your logic becomes:

   Private Sub items_ItemAdd(ByVal Item As Object)
'This macro automatically is triggered any time an item enters your inbox folder

Dim recip As Recipient
Dim moveItem As Boolean
For Each recip In Item.Recipients

moveItem = True

'Filter for RECIPIENTS (e.g. mailing group)
If InStr(recip.Name, "intdev") = 0 Then
moveItem = False
End If

'Filter for SENDER:
If InStr(Item.SenderName, "SQLAdmin") = 0 And InStr(Item.SenderName, "intdev") = 0 Then
moveItem = False
End If

'Exceptions to NOT handle and skip:
'IMPORTANT: use the Not operator!
If Not InStr(Item.Subject, "Supplies") = 0 And Not InStr(Item.Subject, "Referral") = 0 Then
moveItem = False
End If

'check all filters for matches
If matchesSubject(Item.Subject) And moveItem = True Then
Item.Move destFolder
End If

Next recip

End Sub

Private Function matchesSubject(s As String) As Boolean

matches = Array("QueryDatabases", _
"has processed a file", _
"Transaction Cleanup", _
"error", _
"exception", _
"failure")

Dim i As Integer

For i = LBound(matches) To UBound(matches)

If InStr(s, matches(i)) > 0 Then
matchesSubject = True
Exit Function
End If

Next i

matchesSubject = False

End Function


Holy batman changes!

Some observations:

• Your nested if statements are really hard to read.
• I reorganized them significantly, moving all the "match?" checks to a single method
• You could conceivably do the same for the "if not match?" checks, but I left those sequentially. I unnested them by adding a variable those checks set. You could do other things with this, but it makes it more clear and again avoids super-nesting
• I moved the actual set unread/move to a single location. This makes it easier to change in the future (if you want)
• I removed your weird query syntax on all the if blocks (which was inconsistent) and removed some extra () statements you had
• Moving all the matches into an Array makes it a lot easier to see what you are looking for as a match
• You can iterate over the list in a separate function, making it much more clear what you are doing (as well as improving readability and maintenance)

Also you could probably streamline this a lot by modifying the logic here to be "equals" on the email address instead of parsing the name, but that depends on how your notifications are generated.

• This answer is phenomenal, that looks tons better! I'll definitely be refactoring my code this way! – Phrancis Feb 26 '16 at 14:05

I'm too new to comment and I'm not sure this qualifies as an answer, but there are a couple changes I'd suggest:

1. Consider removing the conditions (from, subject-contains, etc.) from the "executing" part of the code and instead putting them into array variables, which you'd define at the top of the macro. Then you could use a Do While loop to compare all the array values to what's in the emails. This will make it a LOT more flexible and easy to work with.
2. Consider more code to fill the array(s) in 1.) above from an external, easy-to-edit source, such as a text file or the body of an email you have saved in a folder somewhere.
3. If you trust your colleagues' judgment you could all share a common text file full of crowd-sourced "bad words." And if you really want to get fancy, you could add sections to the file labeled for each person for the sake of customization.
4. You could write another macro to add/edit/remove "bad words" from the text file so it never actually had to be opened by hand.

### Setting up Outlook

    'Set up Outlook application and inbox variables
Dim nameSpace As Outlook.nameSpace
Dim inbox As Outlook.Folder
Dim destFolder As Outlook.Folder
Set nameSpace = Application.GetNamespace("MAPI")
Set inbox = nameSpace.GetDefaultFolder(olFolderInbox)
Set destFolder = inbox.Folders(destination)


Doing this every single time you're moving one message is a considerable performance hit you're taking when you get into high volumes of emails processed.

Instead of this you're probably better off declaring these on the Module-Level

Dim nameSpace As Outlook.NameSpace
Dim inbox As Outlook.Folder


And then initializing them a little later, as we worked out in chat:

Sub InitOutlookEnv()
If (nameSpace Is Nothing Or inbox Is Nothing) Then
Set nameSpace = Application.GetNamespace("MAPI")
Set inbox = nameSpace.GetDefaultFolder(olFolderInbox)
End If
End Sub


Since destFolder can change every single time you call that sub, it shouldn't be moved to the module level.

### Arrow Code and Checking The Right Things

I really don't like the way you organized and formatted your if-conditions. You may want to consider skipping uninteresting items by just jumping out of the Sub the moment they are uninteresting instead of nesting if-conditions into infinity.

I think it may be even more interesting to get the recipients checked before you process the item. Also .Name may not quite work the way you intended. I daresay not every single one of your colleagues hasn't set the "Display Name" (that's what name is) to something with "intdev" in it.
Instead of relying on configuration in your colleagues' Outlook, you could just check the e-mail address using .Address. It's basically guaranteed not to change :)

The same applies to .SenderName. Here the corresponding check should access .SenderEmailAddress

That's a lot of nested ifs and they mostly fall into each other. Why not use the And & OR operators.

If InStr(recip.Name, "intdev") > 0 And (InStr(item.SenderName, "SQLAdmin") > 0 Or InStr(item.SenderName, "intdev") > 0) _
And Not InStr(item.Subject, "Supplies") > 0 And Not InStr(item.Subject, "Referral") > 0 Then

If ( _
InStr(item.Subject, "QueryDatabases") > 0 _
Or InStr(item.Subject, "has processed a file") > 0 _
Or InStr(item.Subject, "Transaction Cleanup") > 0 _
) _
Then
'Folder to move MISC items to:
'Filters for ERROR items:
ElseIf ( _
InStr(item.Subject, "error") > 0 _
Or InStr(item.Subject, "exception") > 0 _
Or InStr(item.Subject, "failure") > 0 _
) _
Then
'Folder to move ERROR items to:
End If
'If not matching any above conditions, then leave alone
End If


As you're looping through everything it will check for everything at once, but also it's easier to read.

Also, I'm a big fan of using a single procedure to replace a lot rules, so I like it!

While this isn't necessarily related to the code itself, I think it still is worth mentioning: What use is it to have thousands of emails coming in every day from automated systems?

Not only does it have performance issues for your clients, but your mailing server that has to send them all also receives a considerable performance impact. In addition, every mail takes storage space, and every mail costs electricity.

What causes so many mails, I wonder? Either your systems are composed very delicately and break thousands of times per day, or you are getting WAY too detailed information.

As your linked webcomic so delightfully tongue-in-cheek mentions, you should be replacing that with an automated logging system. That way, you can keep all the Transaction Cleanup and Database Query things out of your mailbox. Their place is in a logfile, whether they happen automatically or not. I mean, why do your developers need to know that a certain query was executed? why should they care about Transaction Cleanup mails?

• I absolutely agree, and have voiced that opinion to "higher ups", while I am hoping that the organization will move away from this practice, in the mean time this is a reasonable enough band-aid, so-to-speak! – Phrancis Feb 25 '16 at 22:03
• @Phrancis Word of advice: higher-ups usually think in terms of "How much does this cost the company?". If you can calculate how much money those mails cost the company in lost time, storage and other costs and how much implementing a logging system would cost and save you in terms of manhours to implement and possible licensing costs, you stand a better chance of convincing them. – Nzall Feb 25 '16 at 22:33