Question

目标是仅在满足特定规则（例如，当出现“ the”一词时，将在该电子邮件上运行脚本，突出显示所有出现的“ the”一词。一直在尝试代码，但不知道我要去哪里。该代码似乎已经可以使用，但是在应用时指定的单词不会突出显示。规则标识特定词，例如“ the”，然后脚本将在所标识的电子邮件中在适用的地方突出显示该单词。理想情况下，仅当规则识别此指定单词时才激活脚本。任何帮助将是巨大的，谢谢。

Sub Highlight_AllOccurencesOfSpecificWords(MyMail As Outlook.MailItem)

    Dim strWord As String
    Dim strHTMLBody As String
    Dim ns As Outlook.NameSpace
    Dim moveToFolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem


    strHTMLBody = objMail.HTMLBody
    Set ns = Application.GetNamespace("MAPI")

    'Change the word as per your wishes
    strWord = "the"
    If InStr(strHTMLBody, strWord) > 0 Then
    strHTMLBody = Replace(strHTMLBody, strWord, "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & strWord & "</font>")
    objMail.HTMLBody = strHTMLBody
    End If

    objMail.Save

End Sub 

Updated Code:
Option Compare Text
Sub Highlight_AllOccurencesOfSpecificWords(MyMail As Outlook.MailItem)

    Dim strWord As String
    Dim strHTMLBody As String
    Dim ns As Outlook.NameSpace
    Dim moveToFolder As Outlook.MAPIFolder
    Dim myArray As Variant
    Dim x As Long

    strHTMLBody = MyMail.HTMLBody
    Set ns = Application.GetNamespace("MAPI")
    'Words can be added/removed below in the brackets after Array in (" "), words can be typed within quotation marks
 myArray = Array("today", "tomorrow")

For x = LBound(myArray) To UBound(myArray)
    If InStr(strHTMLBody, myArray(x)) > 0 Then
    strHTMLBody = Replace(strHTMLBody, myArray(x), "<font style=" & Chr(34) & "background-color: turquoise" & Chr(34) & ">" & myArray(x) & "</font>")
    MyMail.HTMLBody = strHTMLBody
    End If
Next x
    MyMail.Save


End Sub

Answer 1

您的宏没有执行任何操作，因为参数为MyMail，但是宏修改了objItem的正文。

删除Dim objItem As Outlook.MailItem

将objItem的{{1}}替换为：

MyMail

我假设您的模块顶部没有strHTMLBody = objMail.HTMLBody objMail.HTMLBody = strHTMLBody objMail.Save。这是一个好习惯，因为它会使这种类型的错误更加难以落实。我收到您的代码的编译时错误。

我认为“ the”是您要突出显示的真实单词的替代物。如果真正的单词晦涩难懂，那么应该没有问题。但是，如果字符串“ the”是URL或类似内容的一部分，则此代码将使电子邮件混乱。

我没有使用规则来测试您的代码。我选择了一封我很乐意破坏并运行以下代码的旧电子邮件：

Option Explicit

我建议使用这种技术来测试几乎所有的Outlook宏。

在Outlook上将脚本作为Word荧光笔运行

1 个答案: