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 with 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 language is 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 BinaryOption Compare Text'No implicit variables allowed:Option ExplicitSub 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:                        MarkReadAndMoveToFolder item, _MiscDump                    '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:                        MarkReadAndMoveToFolder item, _ErrorDump                    End If                    'If not matching any above conditions, then leave alone                End If            End If        End If    Next recipEnd SubPrivate 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.UnRead = False    item.Move destFolderEnd Function
Replace many Outlook email rules with a script
beginner;vba;email;outlook
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 ExplicitPrivate nameSpace As Outlook.nameSpacePrivate inbox As Outlook.FolderPrivate destFolder As Outlook.FolderPrivate WithEvents items As Outlook.itemsPrivate 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) _                       .itemsEnd SubThen 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 recipEnd SubPrivate 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 = FalseEnd FunctionHoly 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 methodYou 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-nestingI 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 hadMoving all the matches into an Array makes it a lot easier to see what you are looking for as a matchYou 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.