如果收件人中有团队电子邮件地址,请删除重复项

时间:2017-06-08 12:16:48

标签: vba email outlook outlook-vba

我们有一个团队电子邮件地址,我们CC用于大多数通信,然后我们都会收到所有电子邮件的副本。

问题是当我们全部回复时,一个团队成员已经在电子邮件链中,该人将收到2次电子邮件。

这就是我的尝试。

Private Sub RemoveRecipientsWhenItemSend(Item As Outlook.MailItem)
Dim RemoveAddrList As VBA.Collection
Dim InfoAddrList As VBA.Collection
Dim Recipients As Outlook.Recipients
Dim aRecipient As Outlook.Recipient
Dim bRecipient As Outlook.Recipient
Dim i
Dim j
Dim a
Dim b
Dim info As Boolean
info = False
Set RemoveAddrList = New VBA.Collection
Set InfoAddrList = New VBA.Collection
InfoAddrList.Add "team@company.com"
RemoveAddrList.Add "member1@company.com"
RemoveAddrList.Add "member2@company.com"
Set Recipients = Item.Recipients
For i = Recipients.Count To 1 Step -1
    Set aRecipient = Recipients.Item(i)
    For j = 1 To InfoAddrList.Count
        If LCase$(aRecipient.Address) = LCase$(InfoAddrList(j)) Then
            For a = Recipients.Count To 1 Step -1
                Set bRecipient = Recipients.Item(a)
                For b = 1 To RemoveAddrList.Count
                    If LCase$(aRecipient.Address) = LCase$(RemoveAddrList(b)) Then
                        Recipients.Remove i
                        Exit For
                    End If
                Next
            Next
            Exit For
        End If
    Next
Next    

End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
On Error Resume Next
RemoveRecipientsWhenItemSend Item
End Sub 

1 个答案:

答案 0 :(得分:1)

一些Debug.Print语句证明是有帮助的。

--max-memory-per-child