Highlight All Occurrences of a Specific Words (in Outlook email) (Public)

PHOTO EMBED

Fri Aug 06 2021 07:00:21 GMT+0000 (UTC)

Saved by @Darkleech #vba

Sub AutoHighlight_AllOccurencesOfSpecificWords(objMail As Outlook.MailItem) 

    Dim strWord As String 

    Dim strHTMLBody As String 

  

    strHTMLBody = objMail.HTMLBody 

  

    'Change the word as per your wishes 

    strWord = "Pulse" 

  

    'If find the specific word 

    If InStr(strHTMLBody, strWord) > 0 Then 

       'Highlight it in yellow color 

       strHTMLBody = Replace(strHTMLBody, strWord, "<font style=" & Chr(34) & "background-color: yellow" & Chr(34) & ">" & strWord & "</font>") 

  

       objMail.HTMLBody = strHTMLBody 

    End If 

  

    'Add more words to be highlighted as per your needs 

    strWord = "Outlook" 

  

    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 

 

Sub HighlightString(MyMail As Outlook.MailItem) 

Dim strID As String 

Dim objMail As Outlook.MailItem 

strID = MyMail.EntryID 

Set objMail = Application.Session.GetItemFromID(strID) 

wordToSearch = "Pulse" 

' Ineed to find a way to match keyword from this line, assigned to wordToSearch 

 

If InStr(1, objMail.HTMLBody, wordToSearch, vbTextCompare) > 0 Then 

strData = objMail.HTMLBody 

strData = Replace(strData, wordToSearch, "<FONT style=" & Chr(34) & "BACKGROUND-COLOR: yellow" & Chr(34) & ">" & wordToSearch & "</FONT>") 

objMail.HTMLBody = strData 

objMail.Save 

End If 

Set objMail = Nothing 

End Sub 
content_copyCOPY