Find Text in an email and delete all text after this in Outlook 2010

Question

I am trying to find text in an email and delete all text after this point. I have managed to get a working macro in Word 2010 however I have been unable to replicate something similar in Outlook.

There will always be a certain text heading "Text" and then some text after this which does differ for each email.

The macro I have been using for word: This was taken from Find a string in a document and delete everything after it

Sub DeleteText()

Set myRange = Application.ActiveInspector.CurrentItem
myRange.Find.Execute FindText:="Text", _
    Forward:=True
If myRange.Find.Found = True Then
myRange.SetRange (myRange.End + 1), ActiveDocument.Content.End
myRange.Delete

End If

End Sub

Any suggestions on how something similar can be implemented in Outlook 2010?

Answer 1

First open a mail item then try this untested code.

Option Explicit

Sub DeleteAfterText()

' Deletes all text after endStr.

Dim currMail As mailitem
Dim msgStr As String

Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long

Set currMail = ActiveInspector.CurrentItem
endStr = "Text"
endStrLen = Len(endStr)

msgStr = currMail.HTMLBody
endStrStart = InStr(msgStr, endStr)

If endStrStart > 0 Then
    currMail.HTMLBody = Left(msgStr, endStrStart + endStrLen)
End If

End Sub