Запуск сценария в Outlook в качестве средства выделения текста

Question

Цель состоит в том, чтобы запускать сценарий в 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

Answer 1

Ваш макрос ничего не делает, потому что параметр MyMail, но макрос изменяет тело objItem.

Удалить Dim objItem As Outlook.MailItem

Заменить objItem на MyMail в:

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

Я полагаю, у вас нет Option Explicit в верхней части вашего модуля.Это хорошая практика, потому что это делает ошибку такого типа более трудной для принятия.Я получаю сообщение об ошибке компиляции с вашим кодом.

Я предполагаю, что "вместо" заменяет реальное слово, которое вы хотите выделить.Если настоящее слово неясно, тогда не должно быть проблем.Однако, если строка «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.