I have more than 10 email accounts all opened in outlook 2016, I have some rule to collect all emails with specific subject to a folder in on of my mail accounts, the problem here that I have to select every single mailbox then run the rule from it, is their any way to run rule on all mailboxes (accounts) at once?


After searching the internet, I found the following VBA code that can run rule or rules on all email accounts, the code is below:

Sub RunRulesSecondary()

Dim oStores As Outlook.Stores
Dim oStore As Outlook.Store

Dim olRules As Outlook.Rules
Dim myRule As Outlook.Rule
Dim olRuleNames() As Variant
Dim name As Variant

' Enter the names of the rules you want to run
olRuleNames = Array("Rule1")

Set oStores = Application.Session.Stores
For Each oStore In oStores
On Error Resume Next

' use the display name as it appears in the navigation pane
If oStore.DisplayName <> "email@domain.ddns.net" Then

Set olRules = oStore.GetRules()

For Each name In olRuleNames()

    For Each myRule In olRules
       Debug.Print "myrule " & myRule

     If myRule.name = name Then

' inbox belonging to oStore
' need GetfolderPath functionhttp://slipstick.me/4eb2l
        myRule.Execute ShowProgress:=True, Folder:=GetFolderPath(oStore.DisplayName & "\Inbox")

' current folder
'      myRule.Execute ShowProgress:=True, Folder:=Application.ActiveExplorer.CurrentFolder

       End If

End If
End Sub

Function GetFolderPath(ByVal FolderPath As String) As Outlook.Folder
    Dim oFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer

    On Error GoTo GetFolderPath_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    'Convert folderpath to array
    FoldersArray = Split(FolderPath, "\")
    Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not oFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = oFolder.Folders
            Set oFolder = SubFolders.Item(FoldersArray(i))
            If oFolder Is Nothing Then
                Set GetFolderPath = Nothing
            End If
    End If
    'Return the oFolder
    Set GetFolderPath = oFolder
    Exit Function

    Set GetFolderPath = Nothing
    Exit Function
End Function

the email account email@domain, is the folder where I collect all emails by a specific rule.

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.