Outlook 2017受信者のチームメールの場合、受信者を削除するマクロ

Question

私たちはチームの電子メールアドレスを持っています。ほとんどの通信ではCCとなっており、すべての電子メールを取得します。

ここで、reply allを押すと、チームメンバーがすでに電子メールのチェーンに入っていたときに、その人に電子メールが2回届きます。

私はVBAを使用していない、または知っていないので、ブラインドで試しています。

これは疲れているものの、うまくいきません。

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

私はので、私はコードが悪いです確信しているが、それは私が思い付くことができるものだったVBAを知らない言ったように、任意の助けをいただければ幸いです。

Answer 1

Debug.Printステートメントが役立つことが判明しました。

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