После поиска в Интернете я нашел следующий код VBA, который может запускать правило или правила для всех учетных записей электронной почты, код приведен ниже:
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 Next Next End If Next 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 Next End If 'Return the oFolder Set GetFolderPath = oFolder Exit Function GetFolderPath_Error: Set GetFolderPath = Nothing Exit Function End Function
учетная запись электронной почты email @ domain - это папка, в которой я собираю все электронные письма по определенному правилу.