Как настроить правило для сообщения Outlook, которое соответствует только имени?

Question

У меня есть тонны нежелательных писем от нашей системы продажи билетов, большинство из которых я просто игнорирую, но иногда кто-то упоминает что-то вроде: «Саймон, не могли бы вы взглянуть на это?'

Я хочу отфильтровать их в подпапку, если она содержит слово «simon», но, к сожалению, каждое сообщение заканчивается чем-то вроде

"Сообщение отправлено пользователям John Smith и Simon Johnson"

поэтому, если я добавлю правило для обнаружения 'Simon', оно будет перемещать каждое электронное письмо в папку.

Если я исключу «Саймона Джонсона», он не будет пересылать электронные письма.

Есть ли способ заставить его требовать> 1 экземпляра Саймона или соответствовать только Саймону и игнорировать Саймона Джонсона?

Answer 1

Сценарий VBA подобный следующему, может сделать работу:

Option Explicit

Sub DoubleSimonMessageRule(newMail As Outlook.mailItem)
    Dim a() As String          '  we convert the mail body to an array of string
    Dim EntryID As String
    Dim StoreID As Variant
    Dim mi As Outlook.mailItem
    Dim dest As String
    Dim destFldr As Outlook.Folder
    Dim I As Integer
    Dim iMatch As Integer

    Const pattern = "Simon"
    Const dest1 = "Simon1"     '  destination folder for 1 match
    Const destAny = "SimonAny" '  destination folder for 2+ matches

    On Error GoTo ErrHandler


    '  we have to access the new mail via an application reference
    '  to avoid security warnings
    EntryID = newMail.EntryID
    StoreID = newMail.Parent.StoreID

    Set mi = Application.Session.GetItemFromID(EntryID, StoreID)

    a = Split(mi.body, vbCrLf)
    iMatch = 0
    For I = LCase(a) To UCase(a)
        If InStr(1, a(I), pattern, vbTextCompare) Then
            iMatch = iMatch + 1
        End If
    Next I

    If iMatch < 1 Then
        '  this should not happen, provided our rule is configured properly
        Err.Raise 1, , "No " & pattern & " in Mail"
    ElseIf iMatch = 1 Then
        dest = dest1
    ElseIf iMatch > 1 Then
        dest = destAny
    End If

    Set destFldr = Application.GetNamespace("MAPI").Folders(dest)
    mi.Move destFldr
    ' mi.Delete    '  not sure about this!
    Set mi = Nothing

    Exit Sub

ErrHandler:
    Debug.Print Err.Description
    Err.Clear
    On Error GoTo 0
End Sub

Используйте помощник по правилам Outlook, чтобы вызвать этот сценарий для входящих писем, для которых в теле письма указано "Simon".