找到&替换传入电子邮件中的文本

时间:2012-12-18 08:51:32

标签: vba replace outlook outlook-vba

我正在尝试替换传入电子邮件中的某些文字。

我找到了几个脚本,但这些脚本适用于传出/创建电子邮件。

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

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

此Outlook会话代码:

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

1 个答案:

答案 0 :(得分:2)

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

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

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

将代码放在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