Create and run Outlook Rules using VBA (Visual Basic for Applications)

Rule

Helps organizing your work based on certain conditions. Outlook offers rules creation by which you can move specific emails to a specific locations based on given criteria. In this PoC we will write code to move all mails having specific subject into a test folder which is created under Inbox folder.

Rule Creation

1. Right click on the mail explorer on any mail item
2. Select Rules under popup, then create rules as shown below figure 1.1
3. In Popup, mentioned the conditions
4. Click on Select Folder button and browse the folder in which you would like to move mails as shown below figure 1.2

Figure 1.1: Create rules

Figure 1.2: Setting conditions for rule

Code example

Sub CreateRule()
    Dim oRules As Outlook.Rules
    Dim oRule As Outlook.Rule
    Dim oRuleActions As Outlook.RuleActions
    Dim oMoveRuleAction As Outlook.MoveOrCopyRuleAction
    Dim oFromCondition As Outlook.ToOrFromRuleCondition
    Dim oExceptSubject As Outlook.TextRuleCondition
    Dim oInbox As Outlook.Folder
    Dim oMoveTarget As Outlook.Folder
     'Outlook application object declaration
    Dim oApp As Outlook.Application
    
    'bind current outlook instance
    Set oApp = GetObject("", "Outlook.Application")

    'Specify target folder for rule move action
    Set oInbox = oApp.Session.GetDefaultFolder(olFolderInbox)
    
    'Target folder already exists
    Set oMoveTarget = oInbox.Folders("test")
     
    'Get Rules from Session.DefaultStore object
    Set oRules = oApp.Session.DefaultStore.GetRules()
     
    'Create the rule by adding a Receive Rule to Rules collection
    Set oRule = oRules.Create("Advertise rule", olRuleReceive)
 
    'Condition is if the message is from "Dan Wilson"
    Set oFromCondition = oRule.Conditions.From
    With oFromCondition
        .Enabled = True
        .Recipients.Add ("support@maildomain.co")
        .Recipients.ResolveAll
    End With
 
    'Action is to move the message to the target folder
    Set oMoveRuleAction = oRule.Actions.MoveToFolder
    With oMoveRuleAction
        .Enabled = True
        .Folder = oMoveTarget
    End With
 
    'Exception condition is if the subject contains "Feedback" or "sride"
    Set oExceptSubject = _
        oRule.Exceptions.Subject
    With oExceptSubject
        .Enabled = True
        .Text = Array("Feedback", "sride")
    End With
 
    'Update the server and display progress dialog
    oRules.Save
    
    'Execute rule
    For Each oRule In oRules
        oRule.Execute
    Next oRule
    
    'CleanUp
    If Not oRule Is Nothing Then
        Set oRule = Nothing
    End If
    If Not oRules Is Nothing Then
        Set oRules = Nothing
    End If
    If Not oExceptSubject Is Nothing Then
        Set oExceptSubject = Nothing
    End If
    If Not oMoveRuleAction Is Nothing Then
        Set oMoveRuleAction = Nothing
    End If
    If Not oFromCondition Is Nothing Then
        Set oFromCondition = Nothing
    End If
    If Not oMoveTarget Is Nothing Then
        Set oMoveTarget = Nothing
    End If
    If Not oApp Is Nothing Then
        Set oApp = Nothing
    End If
End Sub

Output

Next >> Get Account or Account type in Outlook using VBA code

Share on Facebook

Tweet