Solved

BCC automatically on one of two accounts

Posted on 2008-10-22
6
356 Views
Last Modified: 2012-05-05
I would like to have emails sent from a particular account sent with a BCC automatically.

I've found the attached code snippet for automatically populating the BCC field when an email is sent, placed it in 'ThisOutlookSession' of the VBA editor but it doesn't seem to work. I've gone in and placed a breakpoint but it never seems to fire.

In addition, I would like to have the BCC populate only on one of my two email accounts. How can I do that?
the second piece of code below is supposed to do that but it doesn't seem to fire either.....

HELP!


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
 

    ' #### USER OPTIONS ####

    ' address for Bcc -- must be SMTP address or resolvable

    ' to a name in the address book

    strBcc = "sburrows@hisconsulting.net"
 

    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
 
 

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

    Dim objCDO As MAPI.Session, _

        objMsg As MAPI.message, _

        colFields As MAPI.Fields, _

        objField As MAPI.Field, _

        strAccountName As String

    Item.Save

    Set objCDO = CreateObject("MAPI.Session")

    objCDO.Logon "", "", False, False

    Set objMsg = objCDO.GetMessage(Item.EntryID, Item.Parent.StoreID)

    Set colFields = objMsg.Fields

    On Error Resume Next

    strAccountName = colFields.Item(&H8014001E)

    If Err.Number = -2147221233 Then

        strAccountName = "Default Account"

    End If

    On Error GoTo 0

    Select Case strAccountName

        Case "pop1.company.com"

            Debug.Print "Account1"

        Case "pop2.company.com"

            Debug.Print "Account2"

        Case "Default Account"

            Debug.Print "Default"

    End Select

    Set objMsg = Nothing

    Set objField = Nothing

    Set colFields = Nothing

    objCDO.Logoff

    Set objCDO = Nothing

    Cancel = True

End Sub

Open in new window

0
Comment
Question by:scbdpm
  • 3
  • 3
6 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 22777439
Hi, scbdpm.

First, there are two subroutines with the same name.  That's illegal.  Outlook won't run either one.  Remove one or the other.  Also, make sure that macros are enabled in Outlook.
0
 

Author Comment

by:scbdpm
ID: 22778085
that's not the case.
 
I've tried each seaprately and neither one fires!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22778166
Ok, didn't know that.  They were posted together, so it looked to me as if they were both in use.  Have you verified that macros are enabled in Outlook?
0
Highfive + Dolby Voice = No More Audio Complaints!

Poor audio quality is one of the top reasons people don’t use video conferencing. Get the crispest, clearest audio powered by Dolby Voice in every meeting. Highfive and Dolby Voice deliver the best video conferencing and audio experience for every meeting and every room.

 

Author Comment

by:scbdpm
ID: 22778190
Have 2007. Am new to it.... is this done in Trust Center?
Not sure, could you provide guidance.....
0
 

Author Comment

by:scbdpm
ID: 22779392
ok, so I got the macros working.
 
Now, I am not getting the correct account. I am always getting 'Default Account"....
can you help?
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 22782348
On closer look neither of those macros are for Outlook 2007.  Use this version instead.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

    Dim olkRecipient As Outlook.Recipient

    If Item.Class = olMail Then

        'Change the address on the following line'

        If Item.SendUsingAccount.DisplayName = "myaccount@mycompany.com" Then

            'Change the address on the following line'

            Set olkRecipient = Item.Recipients.Add("someone@company.com")

            olkRecipient.Type = olBCC

            Item.Recipients.ResolveAll

            Item.Save

        End If

    End If

End Sub

Open in new window

0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Learn more about how the humble email signature can be used as more than just an electronic business card. When used correctly, a signature can easily be tailored for different purposes by different departments within an organization.
Granting full access permission allows users to access mailboxes present in their database. By giving full access permission one can open and read the content of any mailbox but cannot send emails from that mailbox.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now