VBA code to add cc recipient based on outcome of option button selection on user form

Hi,

I have the below code to prompt a user if an email about to be sent is to be tracked or not.

if selected to be tracked the prefix *OPO * is added into the front end of the subject box, there is a little proportion of coding at the end of the sub to remove duplicate prefixes when forwarding etc.

I'm completely stuck as to how to get the selection of option button one that drives the prefix to also automate the input of an email address into the CC field. If option button two is selected no email is to be entered.

Current coding I've figured out is below and is held in ThisOutlookSession, any help appreciated.

Thanks,


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


Dim frm As UserForm1
Dim chosenvalue As String
Set frm = New UserForm1
frm.Show vbModal
Select Case True
Case frm.OptionButton1.Value
chosenvalue = "*OPO* "
Case frm.OptionButton2.Value
chosenvalue = ""
Case Else
MsgBox "You did not select a value, Cancelling send."
Cancel = True
Exit Sub
End Select
If TypeName(Item) = "MailItem" Then
Item.Subject = chosenvalue & Item.Subject

End If

strSubject = Item.Subject
strSubject = Replace(strSubject, "*OPO* ", "")
strSubject = "*OPO* " & strSubject
Item.Subject = strSubject

Dim olApp As Outlook.Application
Dim aItem As Object
End Sub

How about

Code:

---

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

Dim frm As UserForm1
Dim chosenvalue As String
Dim strSubject As String
Const strCC As String = "someone@somewhere.com"

    If TypeName(Item) = "MailItem" Then
        strSubject = Item.Subject
        chosenvalue = "*OPO* "

        Set frm = New UserForm1
        frm.Show vbModal
        Select Case True
            Case frm.OptionButton1.Value
                If InStr(1, strSubject, chosenvalue) = 0 Then
                    strSubject = chosenvalue & strSubject
                End If
                Item.Subject = strSubject
                If InStr(1, Item.CC, strCC) = 0 Then
                    Item.Recipients.Add(strCC).Type = 2
                End If
            Case frm.OptionButton2.Value
                If InStr(1, strSubject, chosenvalue) > 0 Then
                    strSubject = Replace(strSubject, chosenvalue, "")
                End If
                Item.Subject = strSubject
                If InStr(1, Item.CC, strCC) > 0 Then
                    Item.CC = ""
                End If
            Case Else
                MsgBox "You did not select a value, Cancelling send."
                Cancel = True
                Exit Sub
        End Select
    End If
End Sub

---

Hi Gmayor, thanks for the above, it seems to work well however outlook then throws an error.

https://ibb.co/cGB9xy

Any ideas on this?

Thanks,

Did you put your CC e-mail address in the line

Code:

---

Const strCC As String = "someone@somewhere.com"

---

I did yes, I've typed the recipient email as you note above.

When you click the action button on the form it does populate the cc field with the email address I entered but it throws the error up just before sending.

Add the indicated line as shown

Code:

---

        End Select
        Item.Recipients.ResolveAll 'This line
    End If
End Sub

---

This works perfectly now, thank you very much for your help :)