`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
`

Option Explicit

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

        Debug.Print LCase$(aRecipient.Address)
        Debug.Print LCase$(InfoAddrList(j))

        If LCase$(aRecipient.Address) = LCase$(InfoAddrList(j)) Then

            For a = Recipients.count To 1 Step -1

                'Set bRecipient = Recipients.Item(a)
                Set aRecipient = Recipients.Item(a)

                For b = 1 To RemoveAddrList.count

                    Debug.Print vbCr & " a: " & a
                    Debug.Print " LCase$(aRecipient.Address): " & LCase$(aRecipient.Address)
                    Debug.Print " LCase$(RemoveAddrList(b)): " & LCase$(RemoveAddrList(b))

                    If LCase$(aRecipient.Address) = LCase$(RemoveAddrList(b)) Then
                        'Recipients.Remove i
                        Recipients.Remove a
                        Exit For
                    End If

                Next

            Next

            Exit For

        End If
    Next
Next

End Sub


Private Sub RemoveRecipientsWhenItemSend_test()
    RemoveRecipientsWhenItemSend ActiveInspector.currentItem
End Sub

' first relsove all recipients per global address book
For Each Recipient In Recipients
    Recipient.Resolve
Next

For i = Recipients.count To 1 Step -1
    For j = Recipients.count To Recipients.count - 1
        If Recipients(i) = Recipients(j) Then
            Recipients.Remove (i)
        End If
    Next j
Next i