Как удалить конкретного получателя из всех шаблонов электронной почты в каталоге на моем рабочем столе?

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

Попробуйте это

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"

Answer 2

Вызовите Application.Session.OpenSharedItem для каждого файла MSG, удалите получателя, позвоните MailItem.Save.