TAKE A STAND AGAINST ALL CAPS EMAILS …

May 21, 2009

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 String

    Dim msgText As String

    Dim replySeparatorPosition As Integer

    Dim 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.EntryID

    Set 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) Then

        replySeparatorPosition = 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) Then

        msgText = 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))) Then

        Dim origSender As String

        Dim replyMessage As String

        Dim objReply As Outlook.MailItem

        Set objReply = objMail.Reply

        replyMessage = "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.Body

        objReply.Body = replyMessage

        objReply.BodyFormat = objMail.BodyFormat

        objReply.Send

        objMail.Delete

        Set objReply = Nothing

    End If

    Set objMail = Nothing

End Sub

Function hasLetters(sourceString As String)

    Dim objRegEx As Object

    Dim matched As Boolean

    Dim Matches As Object

    matched = False

    Set objRegEx = CreateObject("VBScript.RegExp")

    With objRegEx

        .MultiLine = True

        .Global = True

        .Ignorecase = False

    End With

    objRegEx.Pattern = "[a-zA-Z]"

    Set Matches = objRegEx.Execute(sourceString)

    If (Matches.Count > 0) Then

        matched = True

    End If

    hasLetters = matched

End Function