Outlook rules from excel

Question

Hi everyone!

I have a list of goods in excel file - I need outlook to put a mail in special folder if I receive a mail with any name from the mentioned list (in the subject or in the mail txt).

The problem is that i have more than 1000 rows of such goods and put them manually to outlook is very time-consuming.

Moreover such list updates from rime to time so I need to update the rules too.

How can I put all the names in the rule not putting one-by-one?

Thank everyone in advance!

Answer 1

Also this might be useful http://www.vbaexpress.com/forum/showthread.php?54414-Bulk-creating-rules-Outlook-2013&p=334566&viewfull=1#post334566

Answer 2

Hi @AlexeyPA ,

Welcome to our forum!

Based on my research, i didn't find a more convenient way to add all fields in your Excel into a rule in Outlook. As far as Outlook clients are concerned, I'm afraid that you need to add the data from Excel to Outlook rule one by one manually.

---

If the answer is helpful, please click "Accept Answer" and kindly upvote it. If you have extra questions about this answer, please click "Comment".

Note: Please follow the steps in our documentation to enable e-mail notifications if you want to receive the related email notification for this thread.

Answer 3

Hi @AlexeyPA ,

Here is a macro that I think does what you want - it loops through a list in Excel to create rules in an Outlook shared mailbox (not exactly the same for a private mailbox). You 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

If running in Outlook, remember to add reference to Excel. If running in Excel, remember to add reference to Outlook.

Hope it helps!

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 = "******@xyz.zz" 'Your shared mailbox address
    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
					'See MS documentation 
                    
                    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