![]() |
|
#1
|
|||
|
|||
![]()
Hello, I am currently using the script below in Word 2010 to highlight specific words. Is it possible to adapt it to work in Outlook to search for the the same words in a Post? I believe the script was originally posted by Macropod in the Word forums and he suggested I post the question here. If it is not possible to adapt it, does anyone know how to write a similar script to accomplish the same?
Sub HiLightList() Application.ScreenUpdating = False Dim StrFnd As String, Rng As Range, i As Long StrFnd = "display,e/monitor,e/port,mouse,keyboard,case,wide,screen,monitor,e-port" On Error Resume Next For i = 0 To UBound(Split(StrFnd, ",")) Set Rng = ActiveDocument.Range With Rng.Find .ClearFormatting .Text = Split(StrFnd, ",")(i) .Replacement.ClearFormatting .Replacement.Highlight = True .Replacement.Text = "^&" .Forward = True .Wrap = wdFindContinue .Format = True .MatchCase = False .MatchWholeWord = True .MatchWildcards = False .MatchSoundsLike = False .MatchAllWordForms = True .Execute Replace:=wdReplaceAll .MatchAllWordForms = False .Execute Replace:=wdReplaceAll End With Next Set Rng = Nothing Application.ScreenUpdating = True End Sub |
#2
|
|||
|
|||
![]()
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 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 |
#3
|
|||
|
|||
![]() Quote:
|
#4
|
|||
|
|||
![]()
Add the loop from the Word code to the Outlook code.
Code:
Sub SearchMailMessageHighlight() Dim objMail As Outlook.mailItem Dim wordToSearch As String Dim strData As String Dim i As Long Dim StrFnd As String StrFnd = "display,e/monitor,e/port,mouse,keyboard,case,wide,screen,monitor,e-port" ' Must have an open message Set objMail = Application.ActiveInspector.currentItem objMail.Display ' In case it is behind something or minimized For i = 0 To UBound(Split(StrFnd, ",")) wordToSearch = Split(StrFnd, ",")(i) 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 Next Set objMail = Nothing End Sub Last edited by niton; 07-09-2014 at 02:08 PM. Reason: formatting the code |
#5
|
|||
|
|||
![]()
Ok, thank you very much for your help niton. I will mark this thread as Solved; however, I have one last question. Is there a way to make the scrip case insensitive, as the current one appears to be case sensitive? Thanks again.
|
#6
|
|||
|
|||
![]()
Try this
Code:
StrFnd = "Display,E/monitor,E/port,Mouse,Keyboard,Case,Wide,Screen,Monitor,E-port" StrFnd = StrFnd & ",display,e/monitor,e/port,mouse,keyboard,case,wide,screen,monitor,e-port" Code:
If InStr(1, objMail.HTMLBody, wordToSearch, vbBinaryCompare) > 0 Then |
![]() |
Thread Tools | |
Display Modes | |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
AtaLoss | Word VBA | 37 | 09-22-2021 12:04 PM |
![]() |
aolszewski | Word VBA | 3 | 11-23-2013 02:07 AM |
permanently highlight searched words in word 2013 | arjay | Word | 4 | 08-16-2013 09:29 AM |
![]() |
zdodson | Word VBA | 1 | 07-11-2013 04:53 PM |
![]() |
bertietheblue | Word VBA | 9 | 07-01-2013 12:39 PM |