From
http://www.outlookcode.com/threads.a...essageid=33313
For the original you have to pass a mailitem
Code:
Sub CustomMailMessageRule(myMail As Outlook.mailItem)
Dim strID As String
Dim objMail As Outlook.mailItem
Dim wordToSearch As String
Dim strData As String
strID = myMail.EntryID
Set objMail = Application.Session.GetItemFromID(strID)
wordToSearch = "the"
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
You may prefer this which works on the current open item.
Code:
Sub SearchMailMessageHighlight()
Dim strID As String
Dim objMail As Outlook.mailItem
Dim wordToSearch As String
Dim strData As String
' Must have an open message
Set objMail = Application.ActiveInspector.currentItem
objMail.Display ' In case it is behind something or minimized
wordToSearch = InputBox(Prompt:="Enter search string.", Title:="SearchMailMessage", Default:="the")
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
'To reverse highlighting when testing
'strData = Replace(strData, wordToSearch, "<FONT style=" & Chr(34) & "BACKGROUND-COLOR: white" & Chr(34) & ">" & wordToSearch & "</FONT>")
'objMail.HTMLBody = strData
'objMail.save
End If
Set objMail = Nothing
End Sub