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

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.UnRead = False
            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.

StackExchange Code Review Q#121088, answer score: 10