Auto BCC VBA code - Outlook 2016

[abesimpson]

I am using the following code (http://www.outlookcode.com/article.aspx?id=72) to BCC myself from all emails I send:

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 = "someone@somewhere.domain"

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

Works fine as far as it goes but as I have multiple email accounts set up in Outlook (2106) I don't want all the email being sent to "someone@somewhere.domain" . It is important to BCC back to the same account I am sending any email from.

I have found a suggestion that using strBcc = Item.SendUsingAccount instead of a fixed E-mail address would do this but it does not work.


Any help would be appreciated.

k

[Omer]

How about
olNs.CurrentUser

Example


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNs As Outlook.NameSpace
Dim olRecip As Outlook.Recipient
Dim Address As String

Set olNs = Application.GetNamespace("MAPI")

Address = olNs.CurrentUser

Set olRecip = Item.Recipients.Add(Address)
olRecip.Type = olBCC
olRecip.Resolve
End Sub

[abesimpson]

How about
olNs.CurrentUser

Example


Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim olNs As Outlook.NameSpace
Dim olRecip As Outlook.Recipient
Dim Address As String

Set olNs = Application.GetNamespace("MAPI")

Address = olNs.CurrentUser

Set olRecip = Item.Recipients.Add(Address)
olRecip.Type = olBCC
olRecip.Resolve
End Sub

I'm sorry but I'm swimming out of my depth. I tried inserting your code as is, and nothing. Clearly, I am missing something, just don't know what it is...

Regards

a

[abesimpson]

I found the following code here: http://stackoverflow.com/questions/26142593/using-vba-create-a-rule-to-add-a-bcc-address-on-outgoing-outlook-email-dependin

It worked then it just stopped working. Any suggestions?

Again, Thanks in advance.

a




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

Dim objRecip As Recipient
Dim strMsg As String
Dim strSendUsingAccount As String
Dim res As Integer
Dim strBcc As String
On Error Resume Next

'Figure out which email account you are using to send email
strSendUsingAccount = Item.SendUsingAccount

'Throw an error if you are using your internal email account
If strSendUsingAccount = "SomeAddress@Somedomain.***" Then
strMsg = "You are trying to send an email using your internal Scanner Email account, which you can't do..." & vbCr & vbCr & "Please select a DIFFERENT email account to send the email from."
res = MsgBox(strMsg, vbOKOnly + vbExclamation, "Sending Mail Error")
Cancel = True
Exit Sub
End If

'If sending from account
If strSendUsingAccount = "My Name (WORK)" Then
strBcc = "MyName@workdommain.com"
End If

'If sending from account
If strSendUsingAccount = "My Name" Then
strBcc = "MyName@gmail.com"
End If

'Choose whether CC/BCC recipient
Set objRecip = Item.Recipients.Add(strBcc)
objRecip.Type = olBCC

'Resolve it?
objRecip.Resolve

'Clear the recipient
Set objRecip = Nothing

End Sub

[gmayor]

Presumably it stopped working after you closed then re-opened Outlook? In that case see
http://www.gmayor.com/create_and_employ_a_digital_cert.htm (http://www.gmayor.com/create_and_employ_a_digital_cert.htm)

[abesimpson]

Presumably it stopped working after you closed then re-opened Outlook? In that case see
(http://www.gmayor.com/create_and_employ_a_digital_cert.htm)http://www.gmayor.com/create_and_employ_a_digital_cert.htm

That was the answer. I tried setting up a certificate and had some problems so for the very short term I have set "Enable all Macros". Not ideal but for the short term...

Again, many thanks to all.

a

[gmayor]

Setting up a self certificate is problematic because Windows has changed how the certificates are stored, and the default is not the right place - see the web page I posted for details on how to put it right.