Chạy quy tắc triển vọng trên tất cả các hộp thư (Tài khoản)?

Tôi có hơn 10 tài khoản email được mở trong triển vọng 2016, tôi có một số quy tắc để thu thập tất cả các email có chủ đề cụ thể vào một thư mục trong tài khoản thư của tôi, vấn đề ở đây là tôi phải chọn từng hộp thư sau đó chạy quy tắc từ đó là cách nào để chạy quy tắc trên tất cả các hộp thư (tài khoản) cùng một lúc?

Sau khi tìm kiếm trên internet, tôi tìm thấy mã VBA sau có thể chạy quy tắc hoặc quy tắc trên tất cả các tài khoản email, mã dưới đây:

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

tài khoản email email @ domain, là thư mục nơi tôi thu thập tất cả các email theo một quy tắc cụ thể.