I hacked up this code in response to people that send me HTML email in all CAPS with 20 "!" in the subject... This little concoction of code will strip out the offending crud and make it nicer-looking to read.
I'm sure you can find better uses for it ;-)
This code will take the HTML out of an HTML message and move it to the bottom of the message so that you can view the message text-only. (It will also put a nice little "Show HTML" button on the menu-bar so that you can optionally view it as HTML).
If you happen to setup an outlook "Rule" to mark a message as being in category "SPAM", it'll make both the body and subject lower-case.
The code will also remove multiple exclamation points from the subject, and if the subject contains more than Percent amount of upper-case characters, it'll convert the entire subject line to lowercase. (For those times when you get subject lines that are all upper-case)
Please see the code, it's not complicated.
I took the original code from: OstroSoft, here's instructions for use from their site:
In your Outlook menu bar click "Tools" and select "Macro", then "Visual Basic Editor". VBA editor will show up.
Cut and paste the code from the 'VB Macro Script' file below.
When closing Outlook don't forget to save changes you made. Also set macros security level to medium - you'll be prompted on each macro encountered by Outlook. When starting Outlook click on "Enable Macros" button. General suggestion - disable message preview in Inbox folder
VB Macro Script code (v0.1)
' VB Outlook Code - v0.1
' Forces removal of HTML
' Removes multiple exclamation points
' Analyzes subject line for upper-case chars
'
' I hacked up this code in response to people that send me HTML
' email in all CAPS with 20 "!" in the subject... I'm sure you
' can find better uses for it ;-)
'
' Code originally taken from:
' OstroSoft [http://www.ostrosoft.com/vb/disable_html_email.asp]
' (Thanks a million Ostro-guys)
'
' Hacked up by: Scott Hurring [scott at hurring dot com]
' http://hurring.com/code/vb/outlook/
'
'
Public WithEvents oItem As MailItem
Public WithEvents oInspector As Inspector
Public WithEvents oInspectors As Inspectors
Public WithEvents oControl As CommandBarButton
' Handle new mail here
Private Sub Application_NewMail()
On Error Resume Next
Set oFolder = GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each oNewItem In oFolder.Items.Restrict("[Unread] = 0")
oItem = oNewItem
Call KillMultipleExPoints
Call KillEvilUpperCase
Call ThrashSPAM
Call StripHTMLBody
oItem.Save
Next
End Sub
' Open mail view window (Inspector window)
Private Sub oInspector_Activate()
' If it's not an email message, stop
If oItem Is Nothing Then Exit Sub
Call KillMultipleExPoints
Call KillEvilUpperCase
Call ThrashSPAM
Call StripHTMLBody
oItem.Save
' Put Show HTML button to menu bar
If InStr(oItem.Body, "/***** HTML *****/" & vbCrLf) > 0 Then
Set oControl = oInspector.CommandBars("Menu Bar").FindControl(, , "Show HTML")
If oControl Is Nothing Then
Set oControl = oInspector.CommandBars("Menu Bar").Controls.Add
oControl.Tag = "Show HTML"
oControl.Caption = "Show HTML"
End If
oControl.Visible = True
End If
End Sub
' Remove multiple exclamation points, etc...
Private Sub KillMultipleExPoints()
' Remove ALL exclamation points
oItem.Subject = Replace(oItem.Subject, "!!", "")
oItem.Body = Replace(oItem.Body, "!!", "")
End Sub
' Count up all upper-case chars, if they exceed
' a certain percentage, set it all to lowercase
Private Sub KillEvilUpperCase()
'MsgBox "KillEvilUpperCase"
Dim i As Long
Dim UCount As Variant
Dim Percent As Variant
UCount = CDec("0.0")
Percent = CDec("0.5") ' Percent / 100; 0.5 = 50%
If Len(oItem.Subject) > 0 Then
For i = 1 To Len(oItem.Subject)
Code = Asc(Mid(oItem.Subject, i, 1))
If Code >= 65 And Code <= 90 Then
UCount = UCount + 1
End If
Next
' If more than % chars are upper-case, convert all to lower
If ((UCount / Len(oItem.Subject)) > Percent) Then
oItem.Subject = LCase(oItem.Subject)
End If
End If
End Sub
' Take the HTMLBody and comment it out and move it to the bottom
Private Sub StripHTMLBody()
'MsgBox "Strip HTML Body"
Body = oItem.Body
Html = oItem.HTMLBody
' If there's an HTMLBody, convert it to plain-text
If Trim(Html) <> "" Then
Body = Body & vbCrLf & vbCrLf & "/***** HTML *****/" & vbCrLf & _
Html & vbCrLf & "/***** End HTML *****/"
End If
oItem.HTMLBody = ""
oItem.Body = Body
'oItem.Save
End Sub
' How to handle messages in category "SPAM"
Private Sub ThrashSPAM()
If InStr(oItem.Categories, "SPAM") Then
'MsgBox "Category SPAM"
oItem.Body = LCase(oItem.Body)
oItem.Subject = LCase(oItem.Subject)
End If
End Sub
' Convert email message back to HTML format
Private Sub oControl_Click(ByVal Ctrl As Office.CommandBarButton,
CancelDefault As Boolean)
Dim sBody As String
Dim sHTML As String
Dim nStart As Long
Dim nEnd As Long
Set oItem = oInspector.CurrentItem
sBody = oItem.Body
nStart = InStr(sBody, "/***** HTML *****/" & vbCrLf)
If nStart > 0 Then
sHTML = Mid(sBody, nStart + 18)
nEnd = InStr(sHTML, vbCrLf & "/***** End HTML *****/")
If nEnd > 1 Then
sHTML = Left(sHTML, nEnd - 1)
If nStart > 1 Then sBody = Left(sBody, nStart - 1) Else sBody = ""
oItem.Body = sBody
oItem.HTMLBody = sHTML
If Left(oItem.Subject, 4) = "(*) " Then
oItem.Subject = Mid(oItem.Subject, 5)
End If
oControl.Visible = False
End If
End If
End Sub
' Track Inspectors
' (Inspector is a child window, displaying an Outlook item: email, task, note, etc.)
Private Sub Application_Startup()
Set oInspectors = Application.Inspectors
End Sub
' If Outlook item is opened get its Inspector
Private Sub oInspectors_NewInspector(ByVal Inspector As Inspector)
Set oInspector = Inspector
On Error Resume Next
' If Item is not email message - error happens
Set oItem = oInspector.CurrentItem
End Sub
' Close Inspector window
Private Sub oInspector_Deactivate()
On Error Resume Next
oControl.Delete
End Sub