Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations strongm on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Outlook VBA Insert Subject Line Based on MsgBox Response 1

Status
Not open for further replies.

Ifutant

MIS
Nov 29, 2010
22
US
I would like to have a vba script that prompts the user when they press send. I need Yes, No, and Cancel.

When the user answers yes it would insert a comment into the subject line and send the email.
Code:
Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
olkMsg.Subject = "[Sending Secure]"

When the user answers no it would send the email like yes would without the comment. ( Currently the code below, the function of yes is what I want the function of no to do.)

I figured out how to make cancel do exactly what I want.

This example I found with some tweaking does partially what I need.

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

Dim MsgQuery As String
 
    If TypeOf Item Is Outlook.MailItem Then
        MsgQuery = "You are sending this email to :" & vbCr & vbCr
        If Item.Recipients.Count > 0 Then
            For i = 1 To Item.Recipients.Count
                MsgQuery = MsgQuery & vbTab & Item.Recipients(i) & vbCr
            Next
        End If
        MsgQuery = MsgQuery & vbCr & "Are you sure you want to send this email?"
        If MsgBox(MsgQuery, vbYesNoCancel + vbQuestion + vbMsgBoxSetForeground, Item.Subject) = vbCancel Then
            Cancel = True
        End If
    End If
 
End Sub

I've been searching and playing with the code all day, any help would be amazing!

 
So I guess what the main issue that I'm encountering is how do I have the yes button insert a customized subject line.
 
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim MsgQuery As String
 
    If TypeOf Item Is Outlook.MailItem Then
        MsgQuery = "You are sending this email to :" & vbCr & vbCr
        If Item.Recipients.Count > 0 Then
            For i = 1 To Item.Recipients.Count
                MsgQuery = MsgQuery & vbTab & Item.Recipients(i) & vbCr
            Next
        End If
        MsgQuery = MsgQuery & vbCr & "Would you like to Encrypt this message?"
        If MsgBox(MsgQuery, vbYesNo + vbQuestion + vbMsgBoxSetForeground, Item.Subject) = vbYes Then
            Cancel = False
        Else
        Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
            olkMsg.Subject = "[Sending Secure]"
        End If
    End If
 
End Sub

So I got it to insert the subject in, but now the trouble is having the subject appended rather than replacing the original subject. I want the [sending secure] to be appended to the original subject not just replace it.
 
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim MsgQuery As String
 
    If TypeOf Item Is Outlook.MailItem Then
        MsgQuery = "You are sending this email to :" & vbCr & vbCr
        If Item.Recipients.Count > 0 Then
            For i = 1 To Item.Recipients.Count
                MsgQuery = MsgQuery & vbTab & Item.Recipients(i) & vbCr
            Next
        End If
        MsgQuery = MsgQuery & vbCr & "Would you like to Encrypt this message?"
        If MsgBox(MsgQuery, vbYesNo + vbQuestion + vbMsgBoxSetForeground, Item.Subject) = vbYes Then
            Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
            olkMsg.Subject = "[Send Secure]"
        
        
        End If
    End If
 
End Sub


Need to append to subject.
 
Getting really close.

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

Dim MsgQuery As String
 
    If TypeOf Item Is Outlook.MailItem Then
        MsgQuery = "You are sending this email to :" & vbCr & vbCr
        If Item.Recipients.Count > 0 Then
            For i = 1 To Item.Recipients.Count
                MsgQuery = MsgQuery & vbTab & Item.Recipients(i) & vbCr
            Next
        End If
        MsgQuery = MsgQuery & vbCr & "Would you like to Encrypt this message?"
        If MsgBox(MsgQuery, vbYesNo + vbQuestion + vbMsgBoxSetForeground, Item.Subject) = vbYes Then
            Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
            olkMsg.Subject = "[Send Secure]"
      
       End If
    End If
 
End Sub

Now I need a way to have the user cancel and allow them to edit the email. Either allow the x command to work or to use a vbYesNoCancel. Any suggestions?
 
Ok so Now all I need is, how to have cancel let the user go back to the email.

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

Dim MsgQuery As String
 
    If TypeOf Item Is Outlook.MailItem Then
        MsgQuery = "You are sending this email to :" & vbCr & vbCr
        If Item.Recipients.Count > 0 Then
            For i = 1 To Item.Recipients.Count
                MsgQuery = MsgQuery & vbTab & Item.Recipients(i) & vbCr
            Next
        End If
        MsgQuery = MsgQuery & vbCr & "Would you like to Encrypt this message?"
        If MsgBox(MsgQuery, vbYesNo + vbQuestion + vbMsgBoxSetForeground, Item.Subject) = vbYes Then
            Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
            olkMsg.Subject = "[Send Secure]" & olkMsg.Subject
      
       End If
    End If
 
End Sub
 
How about something like this:

Code:
Select Case MsgBox(MsgQuery, vbYesNoCancel Or _
    vbQuestion Or vbDefaultButton1, Item.Subject)
        ...
    Case vbYes
        ...
    Case vbNo
        ...
    Case vbCancel
        ...
End Select
Easy to read.

Have fun.

---- Andy
 
Thanks.

I was thinking about using case statements to make it work.

I'm still trying to figure out how to cancel an ItemSend Event.
 
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim MsgQuery As String
 
    If TypeOf Item Is Outlook.MailItem Then
        MsgQuery = "You are sending this email to :" & vbCr & vbCr
        If Item.Recipients.Count > 0 Then
            For i = 1 To Item.Recipients.Count
                MsgQuery = MsgQuery & vbTab & Item.Recipients(i) & vbCr
            Next
        End If
        MsgQuery = MsgQuery & vbCr & "Are you sure you want to send this email?"
        If MsgBox(MsgQuery, vbYesNo + vbQuestion + vbMsgBoxSetForeground, Item.Subject) = vbNo Then
            Cancel = True
        End If
    End If

Select Case MsgBox("Would you like to Encrypt this message?", vbYesNoCancel)

Case Is = vbYes
Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
             olkMsg.Subject = "[Send Secure]" & olkMsg.Subject
             Set olkMsg = Nothing

Case Is = vbNo
Cancel = False

Case Is = vbCancel
Cancel = True

Case Else
Debug.Print "Whoops"
End Select

End Sub

I have that. Now I want to combine the two msgboxes. The second case box works exactly like I want it. How do i display the recipient in the second box.
 
This is the code that I'm using. I would love if it showed who the recipient is in the msg box.

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

Select Case MsgBox("Would you like to Encrypt this message?", vbYesNoCancel)

Case Is = vbYes
Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
             olkMsg.Subject = "[Send Secure]" & olkMsg.Subject
             Set olkMsg = Nothing

Case Is = vbNo
Cancel = False

Case Is = vbCancel
Cancel = True

Case Else
Debug.Print "Whoops"
End Select

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

Select Case MsgBox("Would you like to Encrypt this message?", vbYesNoCancel + vbQuestion + vbMsgBoxSetForeground, Item.Subject)


Case Is = vbYes
Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
             olkMsg.Subject = "[Send Secure]" & olkMsg.Subject
             Set olkMsg = Nothing

Case Is = vbNo
Cancel = False

Case Is = vbCancel
Cancel = True

Case Else
Debug.Print "Whoops"
End Select

End Sub


Now updated. Works Great. But How to display the recipient in the msgBox?
 

[tt]Case Else[/tt] will NEVER happen, the ONLY responces are: Yes, No, or Cancel
You cannot click anything else in the message box :)

Have fun.

---- Andy
 
This is the final result. Works great!
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
dim msg as string

msg = 
Select Case MsgBox("Would you like to Encrypt this message?", vbYesNoCancel + vbQuestion + vbMsgBoxSetForeground, Item.Subject)


Case Is = vbYes
Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
             olkMsg.Subject = "[Send Secure]" & olkMsg.Subject
             Set olkMsg = Nothing

Case Is = vbNo
Cancel = False

Case Is = vbCancel
Cancel = True

Case Else
Debug.Print "Whoops"
End Select

End Sub



----------------------------------------------------------------------------------------
'you can use this one if you want to have the recipients listed in the message box as well.
----------------------------------------------------------------------------------------

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

Dim msg As String

msg = "Would you like this message Encrypted to the following recipients?" & vbCr & vbCr

If Item.Recipients.Count > 0 Then
    For i = 1 To Item.Recipients.Count
        msg = msg & vbTab & Item.Recipients(i) & vbCr
    Next
End If

Select Case MsgBox(msg, vbYesNoCancel + vbQuestion + vbMsgBoxSetForeground, Item.Subject)

Case Is = vbYes
Set olkMsg = Outlook.Application.ActiveInspector.CurrentItem
             olkMsg.Subject = "[Send Secure]" & olkMsg.Subject
             Set olkMsg = Nothing

Case Is = vbNo
Cancel = False

Case Is = vbCancel
Cancel = True

Case Else
Debug.Print "Whoops"
End Select

End Sub
 
I completed this vba script so that users are prompted to "send secure". Our Encryption device scans our outgoing emails for [Send Secure] in the subject line. This code will reduce the amount of PII sent out of the building! AWESOME!
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top