使用VBA创建一个规则，以在传出的Outlook电子邮件中添加密件抄送地址，具体取决于所使用的帐户

Question

There is an original script found here on Stackoverflow which deals with using VBA script in Outlook to conditionally prevent Outlook from sending email based on from and recipient addresses.

There is another VBA script that I found that automatically added a BCC address to all outgoing email without user intervention when the user clicked on the "Send" button in Outlook.

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

    strBcc = "HR@company.com"
    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

What I would like to do is modify this script so that it would change the BCC address being added depending on WHICH email account the user was using to send the email.

For example:

If oMail.AccountThatImSendingFrom = "myself@privateemail.com" Then

    strBcc = "myaccount@gmail.com"

ElseIf oMail.AccountThatImSendingFrom = "myself@company.com" Then

    strBcc = "HM@company.com"

EndIf

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

I've tried searching extensively, but just can't seem to find a good example that I can adjust.

There is another code example here which I just can't manage to read properly - probably because of all of the imbedded IF statements.

Can anyone help me out or point me in the right direction?

Andrew

Answer 1

I found the answer myself. My code is as follows:

Option Explicit

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 = "UserName@Internal.Dom" 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 using your first account
  If strSendUsingAccount = "user@privateemail.com" Then
      strBcc = ""
  End If

  'If sending using your second account
  If strSendUsingAccount = "user@workemail.com" Then
      strBcc = "HR@workemail.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