VBA to find and delete all highlighted text in an email-CodePudding

I need to use VBA to find and delete all highlighted text in an email body. I was trying to use WordEditor in Outlook VBA to do so. I know the following would work in a Word document because I recorded the macro in Word:

 .Find.ClearFormatting
    .Find.Highlight = True
    .Find.Replacement.ClearFormatting
    With .Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
        MsgBox "running macro"
    End With
    Selection.Find.Execute Replace:=wdReplaceAll

Can someone help with defining all the necessary Outlook objects and code that I need to include in the Outlook macro?

I know I need to dim ObjectInspector and a few other objects. I am fairly new to Outlook VBA objects and don't know what is required to make it work.

Any help will be greatly appreciated.

CodePudding user response：

To deal with the Word editor in Outlook you need to use the Inspector.WordEditor property which returns the Microsoft Word Document Object Model of the message. You can use the following ways to get an instance of the Inspector class:

Use the ActiveInspector method to return the object representing the currently active inspector (if there is one).

Sub CloseItem()  
 Dim myinspector As Outlook.Inspector 
 Dim myItem As Outlook.MailItem  
 Set myinspector = Application.ActiveInspector  
 Set myItem = myinspector.CurrentItem  
 myItem.Close olSave  
End Sub

Use the GetInspector property to return the Inspector object associated with an item.

Sub InsertBodyTextInWordEditor() 
 Dim myItem As Outlook.MailItem 
 Dim myInspector As Outlook.Inspector 
 'You must add a reference to the Microsoft Word Object Library 
 'before this sample will compile 
 Dim wdDoc As Word.Document 
 Dim wdRange As Word.Range 
 
 On Error Resume Next 
 Set myItem = Application.CreateItem(olMailItem) 
 myItem.Subject = "Testing..." 
 myItem.Display 
 'GetInspector property returns Inspector 
 Set myInspector = myItem.GetInspector 
 'Obtain the Word.Document for the Inspector 
 Set wdDoc = myInspector.WordEditor 
 If Not (wdDoc Is Nothing) Then 
 'Use the Range object to insert text 
 Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count) 
 wdRange.InsertAfter ("Hello world!") 
 End If 
End Sub

CodePudding user response：

Thank you. I have changed my code to the following but it did not work. Please note that my email composition windows is opened and a full text is in the email body but the text has multiple lines that are highlighted scattered throughout the body. I want the macro to do a replace all to replace all lines that are highlighted with nothing. Basically to remove all lines that are highlighted. The macro VBA references included Word 2016 library and so there is no compile error. But when I run the macro, nothing happens. The highlighted lines remain after the macro is run.
Here is the code:

Sub DeleteHighlightedText()

Dim myinspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim wdDoc As Word.Document
Dim wdRange As Word.Range
 
On Error Resume Next 

Set myinspector = Application.ActiveInspector
Set myItem = myinspector.CurrentItem
 
Set wdDoc = myItem.Inspector.WordEditor

Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)

wdRange.Find.ClearFormatting
wdRange.Find.Highlight = True
wdRange.Find.Replacement.ClearFormatting
With wdRange.Find
     .Text = ""
     .Replacement.Text = ""
     .Forward = True
     .Wrap = wdFindContinue
     .Format = True
     .MatchCase = False
     .MatchWholeWord = False
     .MatchWildcards = False
     .MatchSoundsLike = False
     .MatchAllWordForms = False
End With
wdRange.Find.Execute Replace:=wdReplaceAll
 
End Sub