Depois de pesquisar na Internet, encontrei o seguinte código VBA que pode executar regras ou regras em todas as contas de email, o código está abaixo:
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 protected]" 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
a conta de email email @ domain, é a pasta em que coleto todos os emails por uma regra específica.
