查找并删除电子邮件第一行中的特定句子

Question

我所有的电子邮件都添加了这句话" 这封电子邮件来自外部来源。除非您认出发件人，否则不要点击链接或打开附件。

我想删除它。;我已经制作了这个宏，但它不起作用。什么也没发生。其他宏在 Outlook 会话中确实有效，因此这不是安全问题。我希望宏需要一分钟左右的时间才能搜索 100 多封电子邮件。但什么也没发生。你能帮忙吗？

Sub RemoveExpressionFOLDER()
Dim outNS As Outlook.NameSpace
Dim outFldr As Outlook.Folder
Dim outMailItems As Outlook.Items
'Dim outMailItem As Outlook.MailItem
Dim outMailItem As Object
Dim myinspector As Outlook.Inspector

Set outNS = Application.GetNamespace("MAPI")
Set outFldr = Application.ActiveExplorer.CurrentFolder
Set myinspector = Application.ActiveInspector

Set outMailItems = outFldr.Items
K = outFldr.Items.Count

'MsgBox (K( 对于 i = 1 到 K

If outMailItems(i).Class <> olMail Then GoTo 20
outMailItems(i).Display

'outMailItems(i).UnRead = True
outMailItems(i).Body = Replace(outMailItems(i).Body, "THINK SECURE. This 
email has come from an external source. Do not click on links or open 
attachments unless you recognise the sender.", "")
'outMailItems(i).HTMLBody = Replace(outMailItems(i).HTMLBody, "THINK SECURE. 
This email has come from an external source. Do not click on links or open 
attachments unless you recognise the sender.", "")
outMailItems(i).Save
Set myinspector = Application.ActiveInspector
Set outMailItems(i) = myinspector.CurrentItem
outMailItems(i).Close olSave
20    Next i
MsgBox ("cleaned ")
Set outMailItems = Nothing
Set outFldr = Nothing
Set outNS = Nothing
End Sub

Answer 1

无需打开邮件项目。

Option Explicit
Sub RemoveExpressionFOLDER()
Dim outFldr As folder
Dim outItems As Items
Dim outMailItem As MailItem
Dim i As Long
Dim cleanCount As Long
Set outFldr = ActiveExplorer.CurrentFolder
Set outItems = outFldr.Items
For i = 1 To outItems.Count
If outItems(i).Class = olMail Then
Set outMailItem = outItems(i)
With outMailItem
'Debug.Print .Subject
If InStr(.Body, "THINK SECURE. This email has come from an external source. Do not click on links or open attachments unless you recognise the sender.") Then
If .BodyFormat = olFormatHTML Then
.HTMLBody = Replace(.HTMLBody, "THINK SECURE. This email has come from an external source. Do not click on links or open attachments unless you recognise the sender.", "")
Else
.Body = Replace(.Body, "THINK SECURE. This email has come from an external source. Do not click on links or open attachments unless you recognise the sender.", "")
End If
.SAVE
cleanCount = cleanCount + 1
End If
End With
End If
Next i
MsgBox (cleanCount & " mailitems cleaned.")
End Sub