首页 > 解决方案 > 在 Outlook 上将脚本作为 Word 荧光笔运行

问题描述

目的是仅在满足特定规则时在 Outlook 上运行脚本,例如,当出现“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

标签: vbaoutlook

解决方案


您的宏什么都不做,因为参数是MyMail,但宏修改了objItem.

删除Dim objItem As Outlook.MailItem

替换objItemMyMail

strHTMLBody = objMail.HTMLBody
objMail.HTMLBody = strHTMLBody
objMail.Save

Option Explicit我假设您的模块顶部没有。这是一种很好的做法,因为它使这种类型的错误更难提交。我的代码出现编译时错误。

我认为“the”可以替代您要突出显示的真实单词。如果真正的词是模糊的,那么应该没有问题。但是,如果字符串“the”是 URL 或类似内容的一部分,则此代码会弄乱电子邮件。

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

Sub TestHighlight()

  Dim Exp As Explorer
  Dim ItemCrnt As MailItem

  Set Exp = Outlook.Application.ActiveExplorer

  If Exp.Selection.Count = 0 Then
    Call MsgBox("Please select one or more emails then try again", vbOKOnly)
    Exit Sub
  Else
    For Each ItemCrnt In Exp.Selection
      Call Highlight_AllOccurencesOfSpecificWords(ItemCrnt)
    Next
  End If

End Sub

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


推荐阅读