Link to home
Start Free TrialLog in
Avatar of jledbetter
jledbetter

asked on

Create pop-up warning in Outlook 2010 when selecting "Reply to all"

Hello,

We want to create a pop-up warning box that appears whenever someone selects 'Reply to all' in Outlook 2010.  Ideally we could edit the vbaproject.otm file on everyone's PC to accomplish this.  Editing this file would be a free solution and would also be very easy to deploy.  I'd prefer not to have to install anything or need user intervention. I have seen Sperry, Bells and Whistles, and IvaSoft's TuneReplyAll already.

Thank you,

John
Avatar of Manpreet SIngh Khatra
Manpreet SIngh Khatra
Flag of India image

You can also create a macro to catch the ReplyAll event.

http://msdn.microsoft.com/en-us/library/office/ff869905.aspx
Avatar of jledbetter
jledbetter

ASKER

Thanks for the feedback. Rancy you specified two links that referenced Sperry's software which I had said we are already aware of.  

Yo_bee, what is the easiest way to implement the VBA code for 100 desktops? Do we need to manually touch each computer or could we roll this out in a script?

Thanks,

John
Are you running a Windows 7 enviroment?

If so use Group Policy Preferences to copy the vbaproject.otm  to the default location.
You will need to create the vbaproject.otm
Copy it to a network share (NetLogon)
Create GPP for user's to copy the file to %appdata%\Microsoft\Outlook\vbaProject.OTM

User generated image
You will also have to enable marcos for Outlook so this will work.

User generated image
Yes we are. I didn't realize that this code went into the vbaproject.otm file. I will try it out and post back on the results.
Hi yo_bee, we already have some code in this file and I'm not sure how to integrate it with everything else. When I enter the suggested code, I get the error in the attached screenshot. I pasted the current contents of the file. Could you let me know how to integrate this all together?  The existing code is performing two checks. One to see if the word attachment is used in the email in order to prompt the user to attach a file, and second to prompt for an outlook category if one wasn't already entered. Thank you.

Private objAC As clsApptCategorizer

Private Sub Application_Quit()
    Set objAC = Nothing
End Sub

Private Sub Application_Startup()
    Set objAC = New clsApptCategorizer
End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Attachment Reminder Macro
'Carl C, 17-Sep-08
'http://manage-this.com
'
'Paste this macro into your "ThisOutlookSession" module.
'DISCLAIMER: This was only tested on Outlook 2003
'
'ADDITIONAL CREDITS:
'This macro was created by modifying Mark Bird's original code which
'can be found here: http://mark.bird.googlepages.com/, fixing some
'issues related to search strings on replies/forwards, and also
'merging in additional features/checks taken from examples on Sue
'Mosher's OutlookCode.com. See examples here:
'http://www.outlookcode.com/codedetail.aspx?id=539 and here:
'http://www.outlookcode.com/codedetail.aspx?id=1278 Thanks to Mark
'Bird, Jeremy Gollehon, Steve Bateman, and of course, Sue Mosher
'
Dim m As Variant
Dim strBody As String
Dim intIn, intLength As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer
Dim disclaimer As String
Dim outgoingdisclaimer As String
Dim olkAppt As Outlook.AppointmentItem
On Error GoTo ErrorHandler


outgoingdisclaimer = "Enter Disclaimer Text Here"

'm = MsgBox(outgoingdisclaimer & _
' vbNewLine & vbNewLine & _
'"Do you still want to send this message? ", _
'vbYesNo + vbDefaultButton2 + vbInformation + vbMsgBoxSetForeground, "Reminder")
'If m = vbNo Then
'Cancel = True
'GoTo ExitSub
'End If

'You may have a picture or vCard in your email signature that you
'don't want to be counted when checking for attachments. If so, then
'edit the following line to make intStandardAttachCount equal the
'number of files attached in your signature.
intStandardAttachCount = 0

disclaimer = "This message, including any attachments, " + _
"may contain information that is confidential or privileged, and is intended only for the addressee(s). " + _
"If you are not the intended recipient, you are hereby notified that any use, dissemination, distribution, " + _
"printing, copying, or disclosure of this information is strictly prohibited. If you received this message in error, " + _
"please delete it from your system and notify the sender immediately by return email or by calling"
intDisclaimer = Len(disclaimer)

'CHECK #1: Check for a missing category
If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbQuestion + vbYesNo, "Categorize Meeting Request: " & Item.Subject) = vbNo Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
            
            End If
    End If
    Set olkAppt = Nothing
    
    If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbQuestion + vbYesNo, "Categorize Meeting Request" & Item.Subject) = vbNo Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
        End If
    End If
    Set olkAppt = Nothing
    
'check to see if there is a category after saving appointment


'CHECK #2: Check for a missing attachment
intIn = 0
strBody = LCase(Item.Subject) & LCase(Item.Body)


'If the message is a reply or forward, then the macro will
'not search for the strings in the original message. Anything
'below the "from:" line is ignored

intLength = InStr(1, strBody, "from:")
If intLength = 0 Then intLength = Len(strBody)
strBody = Left(strBody, intLength)

'Add lines for every string you want to check, including other
'languages, etc. Partial strings are fine. For example, "attach"
'will match "attached" & "attachment"
If InStr(1, UCase(strBody), UCase(disclaimer), vbTextCompare) = 0 Then
intDisclaimer = 0
Else
intDisclaimer = intDisclaimer + 10
End If
intLength = intLength - intDisclaimer
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "attach")

intAttachCount = Item.Attachments.Count
If intIn > 0 And intAttachCount <= intStandardAttachCount Then
m = MsgBox("It looks like you forgot to attach a file... " _
& vbNewLine & vbNewLine & _
"Do you still want to send this message? ", _
vbYesNo + vbDefaultButton2 + vbExclamation + vbMsgBoxSetForeground, "Attachment Missing?")
If m = vbNo Then
Cancel = True
GoTo ExitSub
End If
End If
'

'
ExitSub:
Set Item = Nothing
strBody = ""
Exit Sub
'
ErrorHandler:
MsgBox "Send Checker" & vbCrLf & vbCrLf _
& "Error Code: " & Err.Number & vbCrLf & Err.Description
Err.Clear
GoTo ExitSub
End Sub

Open in new window

Try putting the Public WithEvents myItem As MailItem at the very top of your VBA script
Hi I now receive the error in the screenshot when I run this code:

    
Public WithEvents myItem As MailItem
Private objAC As clsApptCategorizer

Private Sub Application_Quit()
    Set objAC = Nothing
End Sub

Private Sub Application_Startup()
    Set objAC = New clsApptCategorizer
End Sub

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
'Attachment Reminder Macro
'Carl C, 17-Sep-08
'http://manage-this.com
'
'Paste this macro into your "ThisOutlookSession" module.
'DISCLAIMER: This was only tested on Outlook 2003
'
'ADDITIONAL CREDITS:
'This macro was created by modifying Mark Bird's original code which
'can be found here: http://mark.bird.googlepages.com/, fixing some
'issues related to search strings on replies/forwards, and also
'merging in additional features/checks taken from examples on Sue
'Mosher's OutlookCode.com. See examples here:
'http://www.outlookcode.com/codedetail.aspx?id=539 and here:
'http://www.outlookcode.com/codedetail.aspx?id=1278 Thanks to Mark
'Bird, Jeremy Gollehon, Steve Bateman, and of course, Sue Mosher
'
Dim m As Variant
Dim strBody As String
Dim intIn, intLength As Long
Dim intAttachCount As Integer, intStandardAttachCount As Integer
Dim disclaimer As String
Dim outgoingdisclaimer As String
Dim olkAppt As Outlook.AppointmentItem
On Error GoTo ErrorHandler


outgoingdisclaimer = "Enter Disclaimer Text Here"

'm = MsgBox(outgoingdisclaimer & _
' vbNewLine & vbNewLine & _
'"Do you still want to send this message? ", _
'vbYesNo + vbDefaultButton2 + vbInformation + vbMsgBoxSetForeground, "Reminder")
'If m = vbNo Then
'Cancel = True
'GoTo ExitSub
'End If

'You may have a picture or vCard in your email signature that you
'don't want to be counted when checking for attachments. If so, then
'edit the following line to make intStandardAttachCount equal the
'number of files attached in your signature.
intStandardAttachCount = 0

disclaimer = "This message, including any attachments, " + _
"may contain information that is confidential or privileged, and is intended only for the addressee(s). " + _
"If you are not the intended recipient, you are hereby notified that any use, dissemination, distribution, " + _
"printing, copying, or disclosure of this information is strictly prohibited. If you received this message in error, " + _
"please delete it from your system and notify the sender immediately by return email or by calling"
intDisclaimer = Len(disclaimer)

'CHECK #1: Check for a missing category
If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbQuestion + vbYesNo, "Categorize Meeting Request: " & Item.Subject) = vbNo Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
            
            End If
    End If
    Set olkAppt = Nothing
    
    If Item.Class = olMeetingRequest Then
        Set olkAppt = Item.GetAssociatedAppointment(False)
        If olkAppt.Categories = "" Then
            If MsgBox("You didn't select a category.  Do you still want to submit the meeting request?", vbQuestion + vbYesNo, "Categorize Meeting Request" & Item.Subject) = vbNo Then
                Cancel = True
                Item.ShowCategoriesDialog
            End If
        End If
    End If
    Set olkAppt = Nothing
    
'check to see if there is a category after saving appointment

'CHECK #2: Check for a missing attachment
intIn = 0
strBody = LCase(Item.Subject) & LCase(Item.Body)


'If the message is a reply or forward, then the macro will
'not search for the strings in the original message. Anything
'below the "from:" line is ignored

intLength = InStr(1, strBody, "from:")
If intLength = 0 Then intLength = Len(strBody)
strBody = Left(strBody, intLength)

'Add lines for every string you want to check, including other
'languages, etc. Partial strings are fine. For example, "attach"
'will match "attached" & "attachment"
If InStr(1, UCase(strBody), UCase(disclaimer), vbTextCompare) = 0 Then
intDisclaimer = 0
Else
intDisclaimer = intDisclaimer + 10
End If
intLength = intLength - intDisclaimer
If intIn = 0 Then intIn = InStr(1, Left(strBody, intLength), "attach")

intAttachCount = Item.Attachments.Count
If intIn > 0 And intAttachCount <= intStandardAttachCount Then
m = MsgBox("It looks like you forgot to attach a file... " _
& vbNewLine & vbNewLine & _
"Do you still want to send this message? ", _
vbYesNo + vbDefaultButton2 + vbExclamation + vbMsgBoxSetForeground, "Attachment Missing?")
If m = vbNo Then
Cancel = True
GoTo ExitSub
End If
End If
'

'
ExitSub:
Set Item = Nothing
strBody = ""
Exit Sub
'
ErrorHandler:
MsgBox "Send Checker" & vbCrLf & vbCrLf _
& "Error Code: " & Err.Number & vbCrLf & Err.Description
Err.Clear
GoTo ExitSub



'CHECK #3: Alert when choosing Reply to All


 
Sub Initialize_Handler()
 
 Set myItem = Application.ActiveInspector.CurrentItem
 
End Sub
 
 
 
Private Sub myItem_ReplyAll(ByVal Response As Object, Cancel As Boolean)
 
 Dim mymsg As String
 
 Dim myResult As Integer
 
 mymsg = "Do you really want to reply to all original recipients?"
 
 myResult = MsgBox(mymsg, vbYesNo, "Flame Protector")
 
 If myResult = vbNo Then
 
 Cancel = True
 
 End If
 
End Sub

Open in new window

I didn't get the screen shot, but there's no End Sub for Private Sub Application_ItemSend ?Maybe got deleted. Note this is demo code, and won't suit your application without modification. For it to work currently, you have to open an email, run the Intialize_Handler macro, then hit Reply All. For every email. It won't work when selecting a an email from the mail explorer windows either. I'm looking for something that will capture both of those events...
Okay thanks. I was hoping for a solution that could run behind the scenes without any user interaction and would be easy to push to 100 client desktops. We already do something along these lines in the vbaproject file that checks for the word attachment and also ensures that a category has been selected. Is anyone aware of how to accomplish the same seamless action when clicking the "reply to all" button?
ASKER CERTIFIED SOLUTION
Avatar of terencino
terencino
Flag of Australia image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial