Consulting

Results 1 to 7 of 7

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

  1. #1

    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
    Last edited by anton1992; 06-18-2018 at 04:28 PM. Reason: Not clear about one point

  2. #2
    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
    Last edited by gmayor; 06-18-2018 at 11:59 PM.
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    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,
    Attached Images Attached Images

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

    Const strCC As String = "someone@somewhere.com"
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  5. #5
    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.

  6. #6
    Add the indicated line as shown

            End Select
            Item.Recipients.ResolveAll 'This line
        End If
    End Sub
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  7. #7
    This works perfectly now, thank you very much for your help

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •