Link to home
Start Free TrialLog in
Avatar of jana
janaFlag for United States of America

asked on

Help in VBA to set BCC email dependent on sender in Outlook 2010

Hi Experts!

Please look at the VBA below.  The script, when creating an email, would always set a fixed BCC email address.  I would like to modify the VBA so it would place the email based on the sender chosen:

User generated image
The image above display the result of the VBA,  What I am trying to accomplish is if I change the "From" or sender", I want the BCC to be that emails.

This is currently the VBA script:
Private Sub m_Inspectors_NewInspector(ByVal Inspector As Inspector)
'Set BCC emails
'This routine is activated when a NEW EMAIL is being created
 Dim objRecip As Recipient
 Dim strMsg As String
 Dim strBCC As String

    If TypeName(Inspector.currentItem) = "MailItem" Then
        If Inspector.currentItem.entryid = "" Then
        ' #### USER OPTIONS ####
        ' address for Bcc -- must be SMTP address or resolvable
        ' to a name in the address book
            strBCC = "jana@domain.com"
            Set objRecip = Inspector.currentItem.Recipients.Add(strBCC)
            objRecip.Type = olBCC
            If Not objRecip.Resolve Then
                strMsg = "Could not resolve the Bcc recipient."
                MsgBox strMsg, vbInformation, "Could Not Resolve Bcc Recipient"
            End If
            Set objRecip = Nothing
        End If
    End If
End Sub

Open in new window

Avatar of Kimputer
Kimputer

To my knowledge, there's no event for clicking From and changing it. You may have to resort to using the ItemSend event instead. You won't really see the BCC being added (probably displayed for mere milliseconds), but it will definitely be filled in.
Avatar of jana

ASKER

Understood in the event, but is there a way in that routine to read or detect who is the sender? maybe extract from there?

Or maybe going thru the Draft folder? When a email is started to work with, I have noticed that it gets created in Draft folder of Outlook; maybe detect a unique number in the open draft email and then read thru the Draft folder? (sorry just think outload there)
The From header is detected in the ItemSend event as 

Mailitem.SentOnBehalfOfName

Do an if or case on that, and decide your BCC based on that.
Avatar of jana

ASKER

Can u prove an example? if based on the script provided, greatly appreciated
Avatar of jana

ASKER

(I meant "can u provide an example?")
Start with this first:

Option Explicit


Public WithEvents myOlApp As Application


Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
 
 Dim prompt As String
 
 prompt = "Are you sure you want to send from: " & Item.SentOnBehalfOfName
 
 If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
 
 Cancel = True
 
 End If
 
End Sub


Private Sub Application_Startup()
 
 Set myOlApp = Application
 
End Sub

Open in new window


This is purely for DEBUGGING reasons.
Send a few emails from each account.

In the best case scenario, your own account is either clearly your own, or could be empty.
All the others NEED to have something filled in. Write down the strings, as they're not always the email address (usually the display name)

After you've collected all the variables, you can adjust the code to have a CASE on those strings.




Avatar of jana

ASKER

Copied the code in ThisOutlookSession and and various emails, but nothing happened.

I exit and enter the outlook apps again and got this message:
User generated image
What am I doing wrong?
You probably have other code already (same name Sub Application_Startup). If you don't need it, delete it. If you need it, merge the subs, so only one remains.
Avatar of jana

ASKER

Yes, u r right, had 'Sub Application_Startup' already.

Ok, I merged your  'Sub Application_Startup'  contents with the present code.  

Placed 'Public WithEvents myOlApp As Outlook.Application'  at the top of  ThisOutlookSession - also place debug on it to see if its detected, but doesn't work.

What am i missing?
Nothing happens at all when sending emails?

Avatar of jana

ASKER

Click 'Send', just sent the email, the code was not detected.

Avatar of jana

ASKER

Looking at the code, I noticed that 'item' of 'Item.SentOnBehalfOfName' is not declared
How should I declare? How?
It doesn't need to be declared:

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

Open in new window

Does ANY other code work at all? If not, you didn't enable macros in your Outlook Options > Trust Center yet.
Avatar of jana

ASKER

None of the code work.  And macros are enable (I use series of routine on a daily bases).

To test further I deleted everything from ThisOutlookSession  and posted you code as is, no results (notice the image below, your code is the only in the section). I assume your code should be trigerred when sending an email -  when sending an email, it sends, your question doesn't pop up.

User generated image
Slight code change, please try again (copy code from same post up here)
Avatar of jana

ASKER

What? Sorry, don't understand/.
I updated the code. Copy and Paste again in your Outlook.
Avatar of jana

ASKER

Sorry, but u haven't upload I don't see it.  Can u post please.
I also told you, I UPDATED the code, so look back up please.
Avatar of jana

ASKER

I understand, but where is it?
You could've read just up here, it's only the 6th post or something? You copied it once. Just copy it again.

https://www.experts-exchange.com/questions/29190531/Help-in-VBA-to-set-BCC-email-dependent-on-sender-in-Outlook-2010.html#a43135811 


Avatar of jana

ASKER

But u said u updated the code.  I didn't look at your 'entry' because I thought u entered a new entry.

u mean u went to your entry and modified it?
Avatar of jana

ASKER

Ok, copied over from you entry where the code is, no results.
Avatar of jana

ASKER

also just finish comparing your code in the entry and the code I had copied initially, they are the same, so same results.
Are you using a proper compare?

You can clearly see it without a compare app:

Old code:
Public WithEvents myOlApp As Outlook.Application

Open in new window

New code:

Public WithEvents myOlApp As Application 

Open in new window

Avatar of jana

ASKER

Value is empty on 'Item.SentOnBehalfOfName':
User generated image
I guess the best way is to show what I did with your code and where I placed it:

This is all the code in "ThisOutlookSession"


 Private WithEvents m_Inspectors As Outlook.Inspectors
 Private m_Folder As Outlook.MAPIFolder
 
'2020-0806 EE Bcc question
 Public WithEvents myOlApp As Application

Private Sub Application_Startup()
 Set m_Inspectors = Application.Inspectors
 
'2020-0806 EE Bcc question
 Set myOlApp = Application

End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Inspector)
'Set BCC emails
'This routine is activated when a NEW EMAIL is being created
 Dim objRecip As Recipient
 Dim strMsg As String
 Dim strBCC As String

    If TypeName(Inspector.currentItem) = "MailItem" Then
        If Inspector.currentItem.entryid = "" Then
        ' #### USER OPTIONS ####
        ' address for Bcc -- must be SMTP address or resolvable
        ' to a name in the address book
            strBCC = "jana@domain.com"
            Set objRecip = Inspector.currentItem.Recipients.Add(strBCC)
            objRecip.Type = olBCC
            If Not objRecip.Resolve Then
                strMsg = "Could not resolve the Bcc recipient."
                MsgBox strMsg, vbInformation, "Could Not Resolve Bcc Recipient"
            End If
            Set objRecip = Nothing
        End If
    End If
End Sub

'2020-0806 EE Bcc question
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
 Dim prompt As String
 prompt = "Are you sure you want to send from: " & Item.SentOnBehalfOfName
 If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
 Cancel = True
 End If
End Sub

Open in new window


Where is the problem?
ASKER CERTIFIED SOLUTION
Avatar of Kimputer
Kimputer

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of jana

ASKER

So I am assuming since u did not comment on the VBA script, then it’s ok.

Will test with another account.
Avatar of jana

ASKER

Please not close this question yet.  There has be lot of work! will review and port status!