在电子邮件中查找文本并在Outlook 2010中删除此后的所有文本

时间:2014-07-31 06:43:20

标签: vba outlook-vba outlook-2010

我正在尝试在电子邮件中查找文本并在此之后删除所有文本。 我已经设法在Word 2010中获得了一个可用的宏,但是我无法在Outlook中复制类似的内容。

总会有一个特定的文字标题" Text"然后在此之后的一些文本对每封电子邮件都有所不同。

我一直在使用的宏:这是从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

有关如何在Outlook 2010中实现类似内容的任何建议吗?

1 个答案:

答案 0 :(得分:2)

首先打开一个邮件,然后尝试这个未经测试的代码。

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