TAKE A STAND AGAINST ALL CAPS EMAILS …
A pet peeve of mine is improper use of the CAPS LOCK key in emails. Marcos Velez has written up a quick Outlook rule that will evaluate an incoming message and test to see if it is written in ALL CAPS. If so, it will delete it and auto-respond to the user asking them to resend the message in proper Sentencing Case. It has some checks in there too in order to verify that the message is of a certain length (to avoid OK, STFU, DOH messages). Typical of Marcos’ code, it is fully commented and a great learning example as well. (Useful for those of us :Me: that hack together other peoples scripts to do my bidding.) This script definitely highlights the power of Microsoft Outlook Rules.
The Code below will send back the following message :
Your message was automatically deleted. This action was taken because the message was written using only capital letters.
If it is important that your message reach its intended recipient, please resend it using proper sentence casing.
— YOUR ORIGINAL MESSAGE IS BELOW THIS LINE —
THIS IS A SAMPLE MESSAGE OF ALL CAPS.
Be sure to add this in as a Macro into Outlook : ALT-F11 (Tools –> Macros –> VB Editor)
Then set up your rule to RUN A SCRIPT :
Here is the code :
Sub DeleteAllCAPS(MyMail As MailItem)'' First, we declare our variables.'Dim strID As StringDim msgText As StringDim replySeparatorPosition As IntegerDim objMail As Outlook.MailItem'' The following code is a nifty way to get around the Outlook security prompts' when macros or scripts are trying to interact with mail items'strID = MyMail.EntryIDSet objMail = Application.Session.GetItemFromID(strID)'' Retrieve the email message itself and store it in a variable'msgText = objMail.Body'' Now, the fun starts...' To ensure that we only evaluate the ORIGINAL message typed by the sender, we look for the' "reply separator". The problem is that different software packages use different separators.'' So, we will look for the two basic ones I see most often. This will be updated regularly to' include other types that I may come across.''' Here we look for the standard Outlook reply separator'replySeparatorPosition = InStr(msgText, "_____ ")'' If we didnt find a reply separator above, we now look for the iPhone reply separator'If (replySeparatorPosition = 0) ThenreplySeparatorPosition = InStr(1, msgText, "--- On ", vbBinaryCompare)End If'' If a reply separator was found, we assume that the original message starts at the first' position and ends at the point where the reply separator starts.'If (replySeparatorPosition > 1) ThenmsgText = Mid(msgText, 1, replySeparatorPosition - 1)End If'' Now, if the original message meets certain criteria, we reject it...!'If ((UCase(msgText) = msgText) And (Len(msgText) > 4) And (hasLetters(msgText))) ThenDim origSender As StringDim replyMessage As StringDim objReply As Outlook.MailItemSet objReply = objMail.ReplyreplyMessage = "Your message was automatically deleted. This action was taken because the message was written using only capital letters."replyMessage = replyMessage & vbCrLf & "If it is important that your message reach its intended recipient, please resend it using proper sentence casing."replyMessage = replyMessage & vbCrLf & vbCrLf & "--- YOUR ORIGINAL MESSAGE IS BELOW THIS LINE ---" & vbCrLf & objMail.BodyobjReply.Body = replyMessageobjReply.BodyFormat = objMail.BodyFormatobjReply.SendobjMail.DeleteSet objReply = NothingEnd IfSet objMail = NothingEnd SubFunction hasLetters(sourceString As String)Dim objRegEx As ObjectDim matched As BooleanDim Matches As Objectmatched = FalseSet objRegEx = CreateObject("VBScript.RegExp")With objRegEx.MultiLine = True.Global = True.Ignorecase = FalseEnd WithobjRegEx.Pattern = "[a-zA-Z]"Set Matches = objRegEx.Execute(sourceString)If (Matches.Count > 0) Thenmatched = TrueEnd IfhasLetters = matchedEnd Function