如何为仅在顶部电子邮件正文中包含特定单词的电子邮件设置规则？

Question

我创建了一条规则，将正文中包含特定单词的电子邮件移动到另一个文件夹。

只要该词出现在旧电子邮件正文中（当您向下滚动到已回复的旧电子邮件时），它就适用。

我需要它仅在最近的电子邮件正文中识别该单词（并忽略线程的其余部分）。

Answer 1

Outlook 不区分旧电子邮件正文和新电子邮件正文。消息正文是单个字符串。您能做的最好的事情就是比较同一对话中两个项目的消息正文并提取较新的部分。因此，接下来您将能够识别关键字是否是新消息的一部分。 GetConversation 方法获取一个

Conversation

对象，该对象表示该项目所属的对话。对话代表一个或多个文件夹和存储中的一项或多项。

使用

Find

类的

FindNext

/

Restrict

或

Items

方法来查找与指定条件相对应的项目。通过以下文章中的代码示例了解有关它们的更多信息：

• 如何：使用 Find 和 FindNext 方法从文件夹中检索 Outlook 邮件项目 (C#、VB.NET)
• 如何：使用限制方法从文件夹中检索 Outlook 邮件项目

您可能会发现 Application 类的 AdvancedSearch 方法很有帮助。在 Outlook 中使用

AdvancedSearch

方法的主要好处是：

• 搜索是在另一个线程中执行的。您不需要手动运行另一个线程，因为

  AdvancedSearch

  方法会在后台自动运行它。
• 可以在任何位置（即超出特定文件夹的范围）搜索任何项目类型：邮件、约会、日历、笔记等。 Restrict 和

  Find

  /

  FindNext

  方法可应用于特定的

  Items

  集合（请参阅 Outlook 中

  Items

  类的

  Folder

  属性）。
• 完全支持 DASL 查询（自定义属性也可用于搜索）。您可以在 MSDN 中的Filtering 文章中阅读有关此内容的更多信息。为了提高搜索性能，如果商店启用了即时搜索，则可以使用即时搜索关键字（请参阅

  IsInstantSearchEnabled

  类的

  Store

  属性）。
• 您可以使用

  Stop

  类的

  Search

  方法随时停止搜索过程。

在以编程方式在 Outlook 中进行高级搜索：C#、VB.NET 文章中了解更多相关信息。

Answer 2

我可以通过将搜索区域限制为线程中第二封电子邮件的电子邮件标题上方的任何内容来做到这一点。

enter code here
Sub CheckTopBodyWords(olItem As Outlook.MailItem)
    Dim strBody As String
    Dim searchWords As String
    Dim found As Boolean

    searchWords = "WORD" ' Replace with your specific words, separated by a pipe (|) symbol

    strBody = GetTextAboveHeader(olItem.Body)
    found = False

If InStr(1, strBody, searchWords, vbTextCompare) > 0 Then
    found = True
End If

If found Then
    ' Replace "Your Folder Name" with the name of your desired folder.
    olItem.Move Outlook.Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("TEST")
End If
End Sub

Function GetTextAboveHeader(fullBody As String) As String
    Dim emailHeaderPatterns As Variant
    emailHeaderPatterns = Array("To:", "From:", "Subject:", "Date:") 
    ' Add more header patterns as needed
    Dim foundHeader As Boolean
    foundHeader = False
    Dim result As String
    result = ""

Dim lines As Variant
lines = Split(fullBody, vbCrLf)

Dim line As Variant
For Each line In lines
    If Not foundHeader Then
        Dim headerPattern As Variant
        For Each headerPattern In emailHeaderPatterns
            If LCase(Left(line, Len(headerPattern))) = LCase(headerPattern) Then
                foundHeader = True
                Exit For
            End If
        Next headerPattern
    End If
    
    If foundHeader Then
        Exit For
    Else
        result = result & line & vbCrLf
    End If
Next line

GetTextAboveHeader = result
End Function

Function RegExpTest(str As String, pattern As String) As Boolean
    Dim regEx As Object
    Set regEx = CreateObject("VBScript.RegExp")

    regEx.pattern = pattern
    regEx.IgnoreCase = True
    regEx.Global = True

    RegExpTest = regEx.Test(str)
End Function