vba - 在收到的电子邮件中查找和替换文本

Question

我正在尝试替换收到的电子邮件中的某些文本。

我找到了几个脚本，但这些脚本用于发送/创建电子邮件。

当前工作代码(感谢 Larry):

Sub testing(MyMail As MailItem)
    MyMail.HTMLBody = Replace(MyMail.HTMLBody, "TESTING", "TESTINGTESTING")
    MyMail.Save
End Sub

此 Outlook session 代码:

Private Sub Application_NewMail()

    Dim mail As MailItem

    Set mail = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.GetFirst
    If mail.Class = olMail Then 'It should be
        'change subject
        mail.Subject = "TESTING"
        'replace body text
        If mail.BodyFormat = olFormatHTML Then
            mail.HTMLBody = Replace(mail.HTMLBody, "TESTING", "TESTINGTESTING")
        Else
            mail.Body = Replace(mail.Body, "SEARCHTEXT", "REPLACETEXT")
        End If
    End If
End Sub

Answer 1

用于处理收件箱中电子邮件的代码。

Sub testing()
    Dim mail As MailItem
    Dim Inbox As Outlook.Folder

    Set Inbox = Session.GetDefaultFolder(olFolderInbox)
    For Each mail In Inbox.Items
        'change subject
        mail.Subject = "TESTING"
        'replace body text
        If mail.BodyFormat = olFormatHTML Then
            mail.HTMLBody = Replace(mail.HTMLBody, "TESTING", "TESTINGTESTING")
        Else
            mail.Body = Replace(mail.Body, "SEARCHTEXT", "REPLACETEXT")
        End If
    Next mail
End Sub

如果您希望在有新邮件时应用宏，请使用以下代码。

将代码放入 ThisOutlookSession 模块。

Private Sub Application_NewMail()
    Dim newMail As MailItem

    Set newMail = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items.GetFirst

    newMail.HTMLBody = Replace(newMail.HTMLBody, "TESTING", "TESTINGTESTING")
End Sub

此代码片段可用于“规则”中的“运行脚本”。

Sub testing(MyMail As MailItem)
    MyMail.HTMLBody = Replace(MyMail.HTMLBody, "TESTING", "TESTINGTESTING")
    MyMail.Save
End Sub