Auto BCC VBA code - Outlook 2016

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

How about

Code:

---

olNs.CurrentUser

---

Example

Code:

---

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

---

Quote:

---

Originally Posted by Omer

How about

Code:

---

olNs.CurrentUser

---

Example

Code:

---

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

I found the following code here: http://stackoverflow.com/questions/2...email-dependin

It worked then it just stopped working. Any suggestions?

Again, Thanks in advance.

a

Code:

---

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

---

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

Quote:

---

Originally Posted by gmayor

Presumably it stopped working after you closed then re-opened Outlook? In that case see
http://www.gmayor.com/create_and_emp...gital_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

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.