Macro to bulk create Outlook rules from CSV file

Here is a macro that loops through a list in Excel to create rules in an Outlook shared mailbox (not exactly the same for a private mailbox). User will need to write the rules that route the emails to the correct folder - the MS documentation is here: https://learn.microsoft.com/en-us/office/vba/api/outlook.rules.create

Remember to add references to Excel when running in Outlook.

Sub CreateRules_SharedMailbox_1()

    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application

    Dim olNamespace As Outlook.NameSpace
    Set olNamespace = olApp.GetNamespace("MAPI")

    Const sharedMailboxName As String = "email address removed for privacy reasons" 'Your shared mailbox name
    Const olFolderInbox As Integer = 6

    Dim olRecipient As Outlook.Recipient
    Set olRecipient = olNamespace.CreateRecipient(sharedMailboxName)
    olRecipient.Resolve

    Dim olFolder As Outlook.Folder
    If olRecipient.Resolved Then
        Set olFolder = olNamespace.GetSharedDefaultFolder(olRecipient, olFolderInbox)
        Dim colRules As Outlook.Rules
        Dim I As Long

        For I = 1 To Session.Stores.Count
            Debug.Print Session.Stores(I)

            If Session.Stores(I).DisplayName = sharedMailboxName Then
                Set colRules = olFolder.Store.GetRules()

                Dim xlApp As Excel.Application
                Set xlApp = CreateObject("Excel.Application")

                Dim wb As Excel.Workbook
                Set wb = xlApp.Workbooks.Open("C:\Users\xyz\YourExcel.xlsx") 'URL and filename for your Excel

                Dim ws As Excel.Worksheet
                Set ws = wb.Sheets("Test") 'Sheet name for your list

                Dim lastRow As Long
                lastRow = ws.Cells(ws.Rows.Count, "A").End(-4162).Row

                Dim iRow As Long
                For iRow = 2 To lastRow '2 to exclude header row
                    Dim trigger As String
                    Dim fldPath As String

                    trigger = ws.Cells(iRow, 1).Value 'Column A contains the trigger values
                    fldPath = ws.Cells(iRow, 2).Value 'Column B contains the fldPath values

                    ' Create a new rule
                    Dim oRule As Outlook.Rule
                    Set oRule = colRules.Create(trigger, olRuleReceive)

                    'Set your rule conditions here
                    
                    Dim oMoveTarget As Outlook.Folder
                    Set oMoveTarget = olFolder.Folders("Test")
             
                Next iRow

                wb.Close False
                xlApp.Quit

                colRules.Save
                Exit For
            End If
        Next

End Sub

cdfjdk 

There are a few errors in your code that are preventing the rules from being created.

Here are the corrections you can make:

1. Missing variable declarations: At the beginning of your code, add the following variable declarations:

vba code:

Dim csvLine As String
Dim trigger As String
Dim folderPath As String

1. Rule conditions and actions: Update the lines where you set the rule conditions and actions:

vba code:

'Set trigger condition
Dim olRuleConditions As Outlook.RuleConditions
Set olRuleConditions = olRule.Conditions

Dim olSubjectCondition As Outlook.TextRuleCondition
Set olSubjectCondition = olRuleConditions.Subject
olSubjectCondition.Text = Array(trigger)

'Set move action
Dim olRuleActions As Outlook.RuleActions
Set olRuleActions = olRule.Actions

Dim olMoveOrCopyRuleAction As Outlook.MoveOrCopyRuleAction
Set olMoveOrCopyRuleAction = olRuleActions.MoveToFolder

With olMoveOrCopyRuleAction
    .Enabled = True
    .Folder = olFolder
End With

1. Exception condition: Update the lines where you set the exception condition:

vba code:

'Set exception exclude messages To (i.e. restrict rule to Cc and Bcc)
Dim oToCondition As Outlook.ToOrFromRuleCondition
Set oToCondition = olRuleConditions.ToOrFrom
With oToCondition
    .Enabled = True
    .Recipients.Add "email address removed for privacy reasons"
    .Recipients.ResolveAll
End With

1. Saving the rules: Move the olRules.Save line outside the loop to save the rules once after all the rules are created.

With these corrections, the macro should be able to read the CSV file, create rules based on the trigger and folder path, and save the rules. Make sure the CSV file is correctly formatted with the trigger in column 1 and the folder path in column 2 for each rule.

Remember to test the code with caution and have a backup of your rules before running it to avoid any unintended changes.The text, steps and the code are the result of various AI's put together.

My answers are voluntary and without guarantee!

Hope this will help you.