在Outlook 2013收件人集合中删除电子邮件收件人

时间:2014-06-04 16:02:01

标签: collections outlook-vba

我似乎无法在一个地方找到我需要的所有东西,而且我是一个VBA菜鸟,所以我不一定能把这些碎片放在一起,但是我看到它们就在那里。

目标:默默地(没有对话框)从ItemSend上的收件人集合中删除一个或多个电子邮件地址。

2-fold问题:似乎我需要按名称或索引删除收件人,但我既不知道如何获取要删除的电子邮件的索引,也不知道如何将其与SMTP地址相匹配。我在此邮件的底部找到了一些获取SMTP地址的代码,但无法找到我需要启动的代码,只需删除收件人即可。然后循环它并匹配到SMTP地址似乎令人生畏。如果有人愿意,我需要一些手握。这对我来说太先进了,但这个概念很简单。

这是noobman关于我想要发生的事情的条款..

 Sub DoNotEmailTheseAddresses()
     Dim Msg As Outlook.MailItem
       Set Msg = Outlook.CreateItem(olMailItem)
       With Msg
         run through IndexNumber to find recipients in To:, CC:, and BCC: collection

         If RecipientIndexNumber.SMTPaddress = "somebody@adomain.com"
             RecipientIndexNumber.SMTPaddress.Remove

        If RecipientIndexNumber.SMTPaddress = "somebodyELSEtoo@adomain.com"
             RecipientIndexNumber.SMTPaddress.Remove

      End With
     End Sub

....然后将电子邮件与somebody@adomain.com和somebodyELSEtoo@adomain.com轻松删除。瞧!

请帮忙,如果这对你来说很容易:)谢谢!

标记

P.S。获取相应的SMTP地址代码在MSDN网站上,这段代码如下... http://msdn.microsoft.com/en-us/library/office/ff866259(v=office.15).aspx

Sub GetSMTPAddressForRecipients(mail As Outlook.MailItem) 
    Dim recips As Outlook.Recipients 
    Dim recip As Outlook.Recipient 
    Dim pa As Outlook.PropertyAccessor 
    Const PR_SMTP_ADDRESS As String = _ 
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E" 
    Set recips = mail.Recipients 
    For Each recip In recips 
        Set pa = recip.PropertyAccessor 
        Debug.Print recip.name & " SMTP=" _ 
           & pa.GetProperty(PR_SMTP_ADDRESS) 
    Next 
End Sub

1 个答案:

答案 0 :(得分:0)

你不是那么遥远......

对于要删除的每个邮件地址,您必须检查所有收件人并检查他们是否有此邮件地址。如果是,请删除它们。因此我将它放入一个单独的函数中,您可以调用每个要删除的邮件地址。

Public Sub newItem_Open(Cancel As Boolean)
  Call removerecipi(newItem, "somebody@adomain.com")
End Sub

Function removerecipi(mailitem As Outlook.mailitem, rec_mail As String)
    Dim i As Long
restart:
    For i = 1 To mailitem.Recipients.Count
        If i > mailitem.Recipients.Count Then GoTo restart
        If mailitem.Recipients(i).SmtpAddress = rec_mail Then mailitem.Recipients.Remove i
    Next i
End Function 

为什么需要重新启动:删除一个收件人后,需要重置mailItem.Recipients.Count。还有其他解决方案,但这个工作正常。