【问题标题】:Find and delete specific sentence in first line of emails查找并删除电子邮件第一行中的特定句子
【发布时间】:2020-03-28 16:36:55
【问题描述】:

我所有的电子邮件都添加了这句话“这封电子邮件来自外部来源。除非您认识发件人,否则请勿单击链接或打开附件。”

我想删除它。;我已经制作了这个宏,但它不起作用。什么都没发生。其他宏在 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

'消息框 (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

【问题讨论】:

  • 需要outMailItem.Save 来保存对正文的更改。如果它是那个奇怪的橙色背景文本行,则可能需要扩展以删除该格式。
  • 正文是正文。 BodyHtml 是 Html 正文。 Outlook 仅显示 Html 正文,因此修改文本正文将无效。尝试修改 BodyHtml。
  • 我已经从社区 Mike 和 Tony 带走了 2 个 cmets;谢谢:我在循环中添加了“保存”行并修改为“HTMLbody”。但仍然没有变化;我还添加了一个临时计数器,查看循环中进行了多少次迭代,但不是遍历所有电子邮件(100+),而是根据文件夹(草稿或收件箱)停在 3 或 4 处。这很奇怪吗?
  • 使用 HTMLBody 测试的功能对我来说效果很好。您的替换语句中的格式不正确,或者您正在过滤不想更新的电子邮件。您目前处于草稿中。这些是您要更新的电子邮件吗?注意 - 即使您删除了 TEXT,它也不会删除 HTML 格式。如果可能,最好识别元素标签并使用替换将其完全删除。
  • 在您的帮助下解决大部分问题。我的印象是查找/替换不适用于收件箱中的现有电子邮件。它们需要打开(显示),这根本不实用?

标签: vba replace outlook find


【解决方案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

【讨论】:

    猜你喜欢
    • 2014-12-29
    • 1970-01-01
    • 2022-11-24
    • 1970-01-01
    • 2021-02-20
    • 2019-01-06
    • 2022-12-16
    • 1970-01-01
    • 2023-01-19
    相关资源
    最近更新 更多