Automatically BCC/CC Send

Hello all,

I am looking a VBA code that puts my colleagues into BCC when I use a specific email domain address.

For example;

Attachment 23604

And example code which is works but not on the way that I want;
Attachment 23605

**original website

So can you please help me to make some adjustments to optimize the code,

Best Regards,

Podious

You just have to check the domain and add the recipients e.g.

Code:

---

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objRecip As Recipient
Dim Res As Integer
Dim strAccount As String
Dim strMessage As String
Const strDomain As String = "yourdomain.com"
Const strBCC1 As String = "emailaddress1"
Const strBCC2 As String = "emailaddress2"
    strAccount = Split(Item.SendUsingAccount.DisplayName, "@")(1)
    If strAccount = strDomain Then
        Set objRecip = Item.Recipients.Add(strBCC1)
        objRecip.Type = olBCC
        If Not objRecip.Resolve Then
            Res = MsgBox("Could not resolve the BCC Recipient " & strBCC1 & vbCr & "Do you want to send the message", vbYesNo)
            If Res = vbNo Then Cancel = True
            Set objRecip = Nothing
        End If
        Set objRecip = Item.Recipients.Add(strBCC2)
        objRecip.Type = olBCC
        If Not objRecip.Resolve Then
            Res = MsgBox("Could not resolve the BCC Recipient " & strBCC2 & vbCr & "Do you want to send the message", vbYesNo)
            If Res = vbNo Then Cancel = True
            Set objRecip = Nothing
        End If
    End If
    Set objRecip = Nothing
End Sub

---