View Single Post
 
Old 07-03-2014, 02:53 PM
niton niton is offline Windows 7 64bit Office 2010 64bit
Competent Performer
 
Join Date: Jul 2012
Posts: 102
niton is on a distinguished road
Default

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
Reply With Quote