I recently had to do some Outlook automation for a client and decided to automate some Outlook configuration which included the creation of Outlook Rules so I thought I’d post an example here in the hopes it might help others as I found it difficult to find good examples to learn from when I needed them.

'---------------------------------------------------------------------------------------
' Procedure : Outlook_CreateRule
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Demonstration of how to use Outlook automation to create a new rule in
'             Outlook from another program.
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - https://creativecommons.org/licenses/by-sa/4.0/
' Req'd Refs: Late Binding  -> none required
'
' Usage:
' ~~~~~~
' Call Outlook_CreateRule
'
' Revision History:
' Rev       Date(yyyy-mm-dd)        Description
' **************************************************************************************
' 1         2020-10-31              Initial Release, Forum Help
'---------------------------------------------------------------------------------------
Public Sub Outlook_CreateRule()
'References:
'https://docs.microsoft.com/en-us/office/vba/outlook/how-to/rules/managing-rules-in-the-outlook-object-model
'https://docs.microsoft.com/en-us/office/vba/api/outlook.ruleconditions
'Early Binding
'          Dim oOutlook              As Outlook.Application
'          Dim oNS                   As Outlook.NameSpace
'          Dim oInbox                As Outlook.Folder
'          Dim oFolder               As Outlook.Folder
'          Dim oColRules              As Outlook.Rules
'          Dim oRule                 As Outlook.Rule
'          Dim oSubjectCondition     As Outlook.TextRuleCondition
'          Dim oSenderAddressCondition As Outlook.AddressRuleCondition
'          Dim oMoveRuleAction       As Outlook.MoveOrCopyRuleAction
'          Dim oMoveDestination           As Outlook.Folder
'Late Binding
    Dim oOutlook              As Object    'Outlook.Application
    Dim oNS                   As Object    'Outlook.NameSpace
    Dim oInbox                As Object    'Outlook.Folder
    Dim oColRules             As Object    'Outlook.Rules
    Dim oRule                 As Object    'Outlook.Rule
    Dim oSubjectCondition     As Object    'Outlook.TextRuleCondition
    Dim oSenderAddressCondition As Object    'Outlook.AddressRuleCondition
    Dim oMoveRuleAction       As Object    'Outlook.MoveOrCopyRuleAction
    Dim oMoveDestination      As Object    'Outlook.Folder
    Dim i                     As Long
    Const olFolderInbox = 6
    Const olMail = 43
    Const olRuleReceive = 0

    On Error Resume Next
    Set oOutlook = GetObject(, "Outlook.Application")        'Bind to existing instance of Outlook
    If Err.Number <> 0 Then        'Could not get instance, so create a new one
        Err.Clear
        Set oOutlook = CreateObject("Outlook.Application")
    End If
    On Error GoTo Error_Handler
    Set oNS = oOutlook.GetNamespace("MAPI")
    Set oInbox = oNS.GetDefaultFolder(olFolderInbox)
    '    Set oInbox = oOutlook.Session.GetDefaultFolder(olFolderInbox)

    'Get the Inscription Folder
    Set oMoveDestination = oInbox.Folders("NameOfTheDestinationFolderToMoveEmailsTo")

    'Get Rules from Session.DefaultStore object
    Set oColRules = oOutlook.Session.DefaultStore.GetRules()
    'Check if the rule already exists
    For i = 1 To oColRules.Count
        If oColRules(i) = oMoveDestination Then
            'The rule name already exists, now what?  Tell the user, Delete it ?
            GoTo Error_Handler_Exit
        End If
    Next i

    'Create the rule by adding a Receive Rule to Rules collection
    Set oRule = oColRules.Create("NameOfNewRule", olRuleReceive)

    'Set the Rule condition(s)
    'Rule 1 - based on received email subject
    Set oSubjectCondition = oRule.Conditions.Subject
    With oSubjectCondition
        .Enabled = True
        .Text = Array("SubjectLineToApplyRuleTo")
    End With
    'Rule 2 - based on the sender's email address
    Set oSenderAddressCondition = oRule.Conditions.SenderAddress
    With oSenderAddressCondition
        .Address = Array("someone@hotmail.com")
        .Enabled = True
    End With

    'Set the Rule action(s)
    Set oMoveRuleAction = oRule.Actions.MoveToFolder
    With oMoveRuleAction
        .Enabled = True
        Set .Folder = oMoveDestination    'Late Binding ONLY!
        '.Folder = oMoveDestination 'Early Binding ONLY!
    End With

    oColRules.Save    'Save the rule
    oRule.Execute    'Run the newly created rule

Error_Handler_Exit:
    On Error Resume Next
    If Not oMoveDestination Is Nothing Then Set oMoveDestination = Nothing
    If Not oSubjectCondition Is Nothing Then Set oSubjectCondition = Nothing
    If Not oMoveRuleAction Is Nothing Then Set oMoveRuleAction = Nothing
    If Not oRule Is Nothing Then Set oRule = Nothing
    If Not oColRules Is Nothing Then Set oColRules = Nothing
    If Not oInbox Is Nothing Then Set oInbox = Nothing
    If Not oNS Is Nothing Then Set oNS = Nothing
    If Not oOutlook Is Nothing Then Set oOutlook = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Outlook_Setup" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Sub

If you review the code you’ll see it uses Late Binding, but I also included the Early Binding variable declarations should you prefer to use Early Binding.

I included 2 type of rule creation: (i) based on the subject line, (ii) based on the sender’s e-mail address, but obviously there are many more rules conditions you can create to learn more look over https://docs.microsoft.com/en-us/office/vba/api/outlook.ruleconditions