none
Outlook BCC script from certain email accounts only RRS feed

  • Question

  • I have been driven mad by this problem. I have three email accounts. I only want to bcc someone if I am using my primary account. 

    I had this script, which was working fine, but is no longer working since I moved to a new machine:

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim objRecip As Recipient

    Dim strMsg As String

    Dim res As Integer

    Dim strBcc As String

    On Error Resume Next

    If Item.SendUsingAccount = "myemailaccount@blank.com" Then

    strBcc = "myboss@blank.com"

    Else: Exit Sub

    End If

    Set objRecip = Item.Recipients.Add(strBcc)

    objRecip.Type = olBCC

    If Not objRecip.Resolve Then

    strMsg = "Could not resolve the Bcc recipient. " & _

    "Do you want still to send the message?"

    res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _

    "Could Not Resolve Bcc Recipient")

    If res = vbNo Then

    Cancel = True

    End If

    End If

    Set objRecip = Nothing

    End Sub

    --------------------------------------------------------------------------------

    Now this part of the script doesn't work at all. 

    If Item.SendUsingAccount = "myemailaccount@blank.com" Then

    strBcc = "myboss@blank.com"

    Else: Exit Sub

    End If

    If I edit it to this, it will at least bcc, but from all my accounts:

    strBcc = "myboss@blank.com"

    ___________________________________________________________

    I have tried everything I can think of and cannot get this to work if I specify my other accounts. I've tried this:

    If not Item.SendUsingAccount = "mysecondaccount@personal.com" Then

    Else: Exit Sub

    End If

    But this doesn't work either. I have tried everything I see on the web and have still been unsuccessful. Can anyone please help?

    Tuesday, November 19, 2019 6:02 PM

All replies

  • How about

    If Item.SenderEmailAddress = "myemailaccount@blank.com" Then


    Graham Mayor - Word MVP
    www.gmayor.com

    Wednesday, November 20, 2019 5:30 AM
  • Thank you for your reply. For some reason when I edit this line, I get an error message saying that the bcc email could not be resolved. Something very weird going on :(
    Wednesday, November 20, 2019 5:09 PM
  • I got that message with your code, however try the following

    Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
    Dim objRecip As Recipient
    Dim res As Integer
    Const strBcc As String = "myboss@blank.com"
    Const strMsg As String = "Could not resolve the Bcc recipient. " & _
          "Do you want still to send the message?"
        On Error Resume Next
        If TypeName(Item) = "MailItem" Then
            If Item.SenderEmailAddress = "myemailaccount@blank.com" Then
                Set objRecip = Item.Recipients.Add(strBcc)
                objRecip.Type = olBCC
                If Not objRecip.Resolve Then
                    res = MsgBox(strMsg, vbYesNo + vbDefaultButton1, _
                                 "Could Not Resolve Bcc Recipient")
                    If res = vbNo Then
                        Cancel = True
                    End If
                End If
                Set objRecip = Nothing
            End If
        End If
    End Sub


    Graham Mayor - Word MVP
    www.gmayor.com

    Thursday, November 21, 2019 12:57 PM
  • I cannot think why, but this didn't work. The email is sent, but there is no bcc.
    Thursday, November 21, 2019 8:17 PM