在所有邮箱(帐户)上运行 Outlook 规则吗?

在所有邮箱(帐户)上运行 Outlook 规则吗?

我在 Outlook 2016 中打开了 10 多个电子邮件帐户,我有一些规则来将所有具有特定主题的电子邮件收集到我的邮件帐户中的一个文件夹中,这里的问题是我必须选择每个邮箱,然后从中运行规则,有没有办法同时在所有邮箱(帐户)上运行规则?

答案1

在互联网上搜索后,我发现了以下 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 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

电子邮件帐户email@domain,是我按照特定规则收集所有电子邮件的文件夹。

相关内容