Как вызвать код для автоматической категоризации входящей электронной почты Outlook 2010 по Regex и VB

Question

Я бы хотел разработать собственное правило для Outlook 2010 для фильтрации электронной почты. Ожидаемый результат с использованием регулярного выражения:

Тема: [ABC] -> создать папку входящих сообщений ABC

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

Не могли бы вы сказать мне, как запустить макрос?

Вот мой код, написанный на VBA

Public Enum Actions
    ACT_DELIVER = 0
    ACT_DELETE = 1
    ACT_QUARANTINE = 2
End Enum


Sub MyNiftyFilter(Item As Outlook.MailItem)
    Dim Matches, Match
    Dim regex As New RegExp
    Dim mc As system.Text.RegularExpressions.MatchCollection
    regex.IgnoreCase = True
    Dim GoodRegEx As New RegExp
    GoodRegEx.IgnoreCase = True

    ' assume mail is good'
    Dim Message As String: Message = ""
    Dim GroupName As String: GroupName = ""
    Dim Action As Actions: Action = ACT_DELIVER

    ' SPAM TEST: Illegal word in subject'
    regex.Pattern = "(v\|agra|erection|penis|boner|pharmacy|painkiller|vicodin|valium|adderol|sex med|pills|pilules|viagra|cialis|levitra|rolex|diploma)"
    GoodRegEx.Pattern = "(([\w-\s]*)\s*)"

    If Action = ACT_DELIVER Then
        If regex.test(Item.Subject) Then
            Action = ACT_QUARANTINE
            Set Matches = regex.Execute(Item.Subject)
            Message = "SPAM: Subject contains restricted word(s): " & JoinMatches(Matches, ",")
        ElseIf GoodRegEx.test(Item.Subject) Then
            Dim results(mc.Count - 1) As String
            For i = 0 To results.Length - 1
                results(i) = mc(i).Value
                If i = 0 Then
                    GroupName = results(i)
                    Set MailDest = ns.Folders(GroupName)
                    Item.Move MailDest
                End If
            Next

        End If
    End If

    ' other tests'

    Select Case Action
        Case Actions.ACT_QUARANTINE
            Dim ns As Outlook.NameSpace
            Set ns = Application.GetNamespace("MAPI")

            Dim junk As Outlook.Folder
            Set junk = ns.GetDefaultFolder(olFolderJunk)

            Item.Subject = "SPAM: " & Item.Subject
            If Item.BodyFormat = olFormatHTML Then
                Item.HTMLBody = "<h2>" & Message & "</h2>" & Item.HTMLBody
            Else
                Item.Body = Message & vbCrLf & vbCrLf & Item.Body
            End If

            Item.Save
            Item.Move junk

        Case Actions.ACT_DELETE
            ' similar to above, but grab Deleted Items folder as destination of move'

        Case Actions.ACT_DELIVER
            ' do nothing'
    End Select
End Sub


Private Function JoinMatches(Matches, Delimeter)
    Dim RVal: RVal = ""

    For Each Match In Matches
        If Len(RVal) <> 0 Then
            RVal = RVal & ", " & Match.Value
        Else
            RVal = RVal & Match.Value
        End If
    Next

    JoinMatches = RVal
End Function


Private Sub Application_NewMail(Item As Outlook.MailItem)
    ' your code here
    MyNiftyFilter (Item)
End Sub

Answer 1

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

Не вводите метод печатным шрифтом, а выбирайте из списка объявлений, см. Рисунок:

 Private Sub Application_NewMail()
    ' your code here
 End Sub

Answer 2

Работа с событием Items.ItemAdd (Outlook)

Option Explicit
Private WithEvents Items As Outlook.Items
Private Sub Application_Startup()
    Dim olNs As Outlook.NameSpace
    Set olNs = Application.GetNamespace("MAPI")

    Dim Inbox  As Outlook.MAPIFolder
    Set Inbox = olNs.GetDefaultFolder(olFolderInbox)

    Set Items = Inbox.Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
    If TypeOf Item Is Outlook.MailItem Then
        Debug.Print Item.Subject
        MyNiftyFilter Items
    End If
End Sub

Происходит при добавлении одного или нескольких элементов к указанномуколлекция. Это событие не запускается при одновременном добавлении большого количества элементов в папку.