我在 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,是我按照特定规则收集所有电子邮件的文件夹。