如何触发Regex和VB对Outlook 2010传入电子邮件进行自动分类的代码 [英] How to trigger code for Automatic Categorisation of Outlook 2010 incoming email by Regex and VB

问题描述

我想为Outlook 2010开发自定义规则以过滤电子邮件.使用正则表达式的预期结果应为:

I would like to develop a custom rule for Outlook 2010 to filter the email. The expected result using regex shall be:

主题:[ABC]->创建收件箱文件夹ABC

Subject : [ABC] --> create inbox folder ABC

我已打开信任中心的宏.在实施和测试时，无法触发此流程.

I have turned on the macro at the Trust Center. When it comes to the implementation and testing, this flow cannot be triggered.

请告诉我如何触发宏?

Would you please tell me how to trigger the macro?

这是我用VBA编写的代码

Here is my code written in 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

推荐答案

您需要使用以下方法运行代码-当收到新邮件时，将触发此方法

You need to run your code in following method - this method is triggered, when the new mail is coming

不加分型方法，而是从声明列表中选择，请参见图片:

Do not hardtyping method, but choose from declaration list, see picture :

 Private Sub Application_NewMail()
    ' your code here
 End Sub

这篇关于如何触发Regex和VB对Outlook 2010传入电子邮件进行自动分类的代码的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！