' 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