Автоматический запуск правил Outlook для папок вне папки “Входящие”.

В данный момент у меня Outlook настроен для работы с Gmail. У меня есть несколько правил, которые я определил и которые применяются к разным папкам (меткам) в моем аккаунте. В Gmail уже настроены фильтры, которые позволяют письмам миновать входящие и попадать в соответствующие папки.

Когда я получаю новое письмо в этих папках, мои правила не выполняются (они только для назначения категорий). Мне приходится запускать их вручную. Я думаю, это потому, что письма не попадают сначала во входящие, а сразу же в папку. Существует ли способ, чтобы Outlook автоматически применял правила к этим папкам? Запланированное выполнение тоже подошло бы.

Вот оно. Обратите внимание, что это специфично для папки с нежелательной почтой (olFolderJunk – это константа в Outlook), и оно будет запускать любой фильтр, который я создам с префиксом “JUNK_FILTER_”.

Это оптимистично и практически не имеет проверок на ошибки, поэтому используйте на свой страх и риск. Не используйте, если не понимаете 🙂

Sub runRulesOnJunkFolder()
    Dim st As Outlook.Store
    Dim myRules As Outlook.Rules
    Dim rl As Outlook.Rule
    Dim count As Integer
    Dim ruleList As String
    Dim rulePrefix As String
    Dim ruleFolder As Long

    '
    Dim outlookApp As Outlook.Application
    Dim objNS As NameSpace


    ruleFolder = olFolderJunk
    rulePrefix = "JUNK_FILTER_"

    Set objNS = Application.GetNamespace("MAPI")
    Set objJunkfolder = objNS.GetDefaultFolder(ruleFolder)

    ' get default store (where rules live)
    Set st = Application.Session.DefaultStore
    ' get rules
    Set myRules = st.GetRules

    ' iterate all the rules
    For Each rl In myRules
        ' determine if it's an Inbox rule and rule name prefix matches
        If rl.RuleType = olRuleReceive And Left(rl.Name, Len(rulePrefix)) = rulePrefix Then

            ' if so, run it
            rl.Execute ShowProgress:=True, Folder:=objJunkfolder
            count = count + 1
            ruleList = ruleList & vbCrLf & rl.Name
        End If
    Next

    ' tell the user what you did
    ruleList = "These rules were executed against the folder: " & objJunkfolder.Name & vbCrLf & ruleList
    MsgBox ruleList, vbInformation, "Macro: runRulesOnJunkFolder"

    Set rl = Nothing
    Set st = Nothing
    Set myRules = Nothing
    Set objJunkfolder = Nothing
    Set objNS = Nothing
End Sub

Категории неправильно работают с учетными записями IMAP. Любые категории, присвоенные объектам Outlook в учетных записях IMAP, не будут синхронизироваться с сервером, и поэтому будут отображаться только в этом конкретном профиле Outlook на данном пользовательском аккаунте в данной установке Windows. Единственное, что вы можете использовать с IMAP и Outlook, это стандартные флаги вкл/выкл (не разные типы, которые поддерживает GMail или Exchange).

Категории предназначены для использования с учетными записями Exchange, где их можно назначать с помощью клиентских правил и затем синхронизировать с сервером. Они также будут нормально работать с учетными записями POP3, где категории будут назначены и письма отсортированы по клиентским правилам.

Поскольку категории могут быть назначены (с помощью клиентских правил) на письма, которые уже были отсортированы в папки на сервере Exchange (с помощью серверных правил), я бы предположил, что ваши правила не работают, потому что категории не предназначены для использования на учетных записях, не относящихся к Exchange.

Я не думаю, что Gmail может быть удовлетворительно использован с любым настольным почтовым клиентом, на мой взгляд, из-за необычного способа, которым настроены почтовые ящики IMAP.

Один из способов это сделать – настроить повторяющееся событие, которое может запускать макрос каждый раз, когда выходит напоминание. Макрос будет запускать фильтр. Это кажется немного громоздким при множестве событий в вашем календаре и, вероятно, не будет срабатывать, когда вам нужно. Я не делал это лично, но уверен, что это возможно.

Что я делал, так это создавал макрос, который запускает любые фильтры, которые названы с конкретным префиксом в определенной папке. Макрос выбирает папку, фильтры определяют действие (в моем случае, ‘удалить’). Это может адаптировать кто-то, кто знает VBA.

После того как я создал макрос, я добавил кнопку на панели инструментов Outlook, которая его запускает. Я нажимаю на эту кнопку, когда мне того хочется.

Я могу опубликовать исходный код, если вы считаете, что сможете его модифицировать под свои нужды.

Вы можете установить эти правила непосредственно в GMail: ссылка.

Код Горацио все еще полезен через 14 лет! Вот обновленная версия, которая дает больше гибкости, с примерами использования. Поместите код ниже в Module1 Outlook (создайте его, если его еще нет). Затем вы можете настроить ленту Outlook, чтобы добавить кнопку, которая вызывает макрос по вашему выбору с нужными вам аргументами runPrefixedRules().

' Макросная подпрограмма не может иметь параметры, мы не можем создать макросы, которые 
' вызывают runPrefixedRules напрямую

' Этот макрос запустит все правила против всех сообщений в Inbox,
Sub runAllRulesInbox()

    runPrefixedRules ""

End Sub
    
' Этот макрос запустит правила, начинающиеся с "FileIt_" против сообщений в "Inbox\File it!"
Sub runFileItRules()

    runPrefixedRules "FileIt_", "\\my Mailbox\Inbox\File it!"

End Sub

' Выполнить правила, соответствующие указанному префиксу, по умолчанию в Inbox или в указанной папке
' основано на https://superuser.com/questions/225211/make-outlook-run-rules-on-non-inbox-folders-automatically
'
' strRulePrefix: Все правила, начинающиеся с указанного префикса, будут выполнены
'
' strFolderPath: Путь к папке, содержащей сообщения, в отношении которых 
'                будут выполнены правила, начиная с почтового ящика
'                ([\\]имя_почтового_ящика[\имя_папки]...)
'
'
' showProgress:  True, чтобы отобразить диалоговое окно прогресса при выполнении правила
'
' showMsgBox:    Если True, в конце появится окно сообщений со списком выполненных правил
'
' ruleExecuteOption: 0: (olRuleExecuteAllMessages)    Выполняет правила по всем сообщениям в папке
'                    1: (olRuleExecuteReadMessages)   Выполняет правила по прочитанным сообщениям в папке
'                    2: (olRuleExecuteUnreadMessages) Выполняет правила по непрочитанным сообщениям в папке
'
' includeSubfolders: Если True, сообщения в подпапках указанного пути папки также будут обработаны
'
'
' Пример простого использования: запускать правила с префиксом "FileIt_" на всех 
'                                 сообщениях только в Inbox (без подпапок),
'                                 показывая прогресс и диалоги с суммированием
'
'       runPrefixedRules "FileIt_"
'
'
' Пример расширенного использования: запускать все правила (пустой префикс) на всех 
'                                     прочитанных сообщениях в папке Inbox\ToBeFiled 
'                                     и всех ее подпапках, из почтового ящика 
'                                     "myMailbox", не отображая выходных данных.
'
'       runPrefixedRules "", "\\myMailbox\Inbox\ToBeFiled", _
'                         False, False, 1, True
'
Sub runPrefixedRules(strRulePrefix As String, _
                     Optional strFolderPath As String = "", _
                     Optional showProgress As Boolean = True, _
                     Optional showMsgBox As Boolean = True, _
                     Optional ruleExecuteOption As Integer, _
                     Optional includeSubfolders As Boolean = False)
                     
    
    Dim objInFolder As Outlook.Folder ' Мы получим объект папки из пространства имен MAPI
    Dim objRules As Outlook.Rules     ' Мы получим пользовательские правила из OutlookStore
    Dim rule As Outlook.rule ' Текущее правило при итерации через objRules
    Dim ruleList As String   ' Будет собирать список выполненных правил
    
    
    ' Получить objInFolder
    If strFolderPath = "" Then
        ' Чтобы изменить используемую папку по умолчанию, выберите другую папку по умолчанию olFolder*
        ' из https://learn.microsoft.com/en-us/office/vba/api/outlook.oldefaultfolders
        Set objInFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
    Else
        Set objInFolder = GetFolder(strFolderPath)
    End If
    
    ' Проверить, что мы получили действительный объект
    If objInFolder Is Nothing Then
        MsgBox "Не удается найти папку '" & strFolderPath & "', GetFolder() вернулся 'Nothing'", vbExclamation, "Макрос: runPrefixedRules"
        Exit Sub
    End If

    Set objRules = Application.Session.DefaultStore.GetRules

    ' Проверить, что мы получили действительные правила
    If objRules Is Nothing Then
        MsgBox "Не удается найти объект правил в DefaultStore!", vbExclamation, "Макрос: runPrefixedRules"
        Exit Sub
    End If
    
    ' итерация по всем правилам
    For Each rule In objRules
        ' определить, является ли это правилом Inbox, и префикс названия правила совпадает
        If rule.RuleType = olRuleReceive And Left(rule.Name, Len(strRulePrefix)) = strRulePrefix Then

            ' если да, запускаем.
            '
            ' Аргументы Outlook.rule.Execute (первый заданный - значение по умолчанию)
            '   ShowProgres:=False|True, IncludeSubfolders:=False|True,
            '   Folder:=Inbox|<объект_папки>, RuleExecuteOption:=olRuleExecuteAllMessages|olRuleExecuteReadMessages|olRuleExecuteUnreadMessages
            '
            ' Ссылка: https://github.com/MicrosoftDocs/VBA-Docs/blob/main/api/Outlook.Rule.Execute.md
            rule.Execute showProgress:=showProgress, _
                         includeSubfolders:=includeSubfolders, _
                         Folder:=objInFolder, _
                         ruleExecuteOption:=ruleExecuteOption
            
            ruleList = ruleList & vbCrLf & rule.Name
        End If
    Next

    ' скажите пользователю, что вы сделали
    If ruleList = "" Then
        ruleList = "Правила, соответствующие префиксу '" & strRulePrefix & "', не найдены"
    Else
        ruleList = "Эти правила были выполнены против папки '" & objInFolder.Name & "':" & vbCrLf & ruleList
    End If
    MsgBox ruleList, vbInformation, "runPrefixedRules()"

End Sub


' https://learn.microsoft.com/en-us/office/vba/outlook/how-to/items-folders-and-stores/obtain-a-folder-object-from-a-folder-path
' https://github.com/MicrosoftDocs/VBA-Docs/blob/main/outlook/How-to/Items-Folders-and-Stores/obtain-a-folder-object-from-a-folder-path.md
'
' Использование:
'    Set folder = GetFolder ("\\Имя_почтового_ящика\Входящие\Клиенты")
'
Function GetFolder(ByVal FolderPath As String) As Outlook.Folder

    Dim TestFolder As Outlook.Folder
    Dim FoldersArray As Variant
    Dim i As Integer
 
    On Error GoTo GetFolder_Error
    If Left(FolderPath, 2) = "\\" Then
        FolderPath = Right(FolderPath, Len(FolderPath) - 2)
    End If
    
    'Преобразовать путь к папке в массив
    FoldersArray = Split(FolderPath, "\")
    Set TestFolder = Application.Session.Folders.Item(FoldersArray(0))
    If Not TestFolder Is Nothing Then
        For i = 1 To UBound(FoldersArray, 1)
            Dim SubFolders As Outlook.Folders
            Set SubFolders = TestFolder.Folders
            Set TestFolder = SubFolders.Item(FoldersArray(i))
            If TestFolder Is Nothing Then
                Set GetFolder = Nothing
            End If
        Next
    End If
     
   'Возвращаем TestFolder
    Set GetFolder = TestFolder
    Exit Function
 
GetFolder_Error:
    Set GetFolder = Nothing
    Exit Function

End Function