Question

我有一个Outlook消息(.msg)的目录文件夹（在桌面上的文件夹），用作制作电子邮件的模板。

此文件夹中可能有500封电子邮件。有时每个月后，我需要从每封电子邮件中删除一个特定的电子邮件地址。

Sub test()

Dim m As MailItem 'object/mail item iterator
Dim recip As Recipient 'object to represent recipient(s)
Dim email As Long

Set Remove = m.Remove

email = InputBox("Please enter the e-mail address you wish to remove")
answer = MsgBox("Are you sure you want to delete this e-mail?", vbYesNo + vbCritical, "Delete?")
If answer = vbYes Then

For Each m In Application.ActiveExplorer.Selection
If m.Class = olMail Then
Set Remove = m.Recipients.Remove(email)

End If

m.Save
End If

Next

End Sub

我如何使用VBA？

如果电子邮件中包含johndoe@gmail.com，我希望在所有TO，CC，BCC等中运行此代码后，该电子邮件将被删除。

Answer 1

为每个MSG文件呼叫Application.Session.OpenSharedItem，删除收件人，然后呼叫MailItem.Save。

Answer 2

尝试一下

Option Explicit
Public Sub Example()
    Dim Path As String
        Path = "C:\Temp"

    Dim msgFile As String
        msgFile = Dir(Path & "\*.msg")

    Dim msg As Object
    Do While Len(msgFile) > 0
        Set msg = Application.Session.OpenSharedItem(Path & "\" & msgFile)
        Debug.Print msg.Subject

            GetSMTPAddress msg

        msgFile = Dir
    Loop

    Set msg = Nothing
End Sub

Private Sub GetSMTPAddress(Mail As Outlook.MailItem)
    Dim pa As Outlook.PropertyAccessor

    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"

    Dim i As Long
    For i = Mail.Recipients.Count To 1 Step -1
        DoEvents
        Set pa = Mail.Recipients(i).PropertyAccessor

        If LCase(pa.GetProperty(PR_SMTP_ADDRESS)) = _
           LCase("0m3r@Email.com") Then
                Mail.Recipients.Remove (i)
                Debug.Print pa.GetProperty(PR_SMTP_ADDRESS)
                Mail.Save
        End If

    Next
End Sub

请确保更新电子邮件地址0m3r@Email.com和文件夹路径Path = "C:\Temp"

如何从桌面目录中的所有电子邮件模板中删除特定收件人？

2 个答案: