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

[anton1992]

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

[gmayor]

How about


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

[anton1992]

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,

[gmayor]

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


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

[anton1992]

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.

[gmayor]

Add the indicated line as shown


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

[anton1992]

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