I have a unusual localised industry specific e-mail client, that doesn't handle HTML only e-mails.
This script modifies the HTML into plain text, and removes the HTMLBody of the e-mail.
This script works for my unusual client, but doesn't make an e-mail that displays in Outlook 2003. This suits me, but it may need to be modified slightly for others.
Modify at will, use at own risk, etc.
Code: Select all
Sub OnDeliverMessage(oMessage)
dim counter, aMessage
for counter = 0 to oMessage.recipients.count -1
if oMessage.recipients(counter).address = "[b]youruser@yourdomain.com[/b]" then
aMessage = StripHTML(oMessage.HTMLBody)
omessage.htmlbody = ""
oMessage.body = aMessage
oMessage.Save
end if
next 'counter
Result.Value = 0
End Sub
function StripHTML(oSource)
dim Result_Text, breaks, tab, i
Result_text = ReplaceText(oSource," ( )+"," ")
Result_text = Replace(Result_text,"=" & vbcrlf,"")
Result_text = Replace(Result_text,";" & vblrcf,"")
'add more lines as above where needed
' Result_text = Replace(Result_text,"=" & vblrcf,"")
' Remove the header (prepare first by clearing attributes)
Result_text = ReplaceText(Result_text,"<( )*head([^>])*>","<head>")
Result_text = ReplaceText(Result_text,"(<( )*(/)( )*head( )*>)","</head>")
Result_text = ReplaceText(Result_text,"(<head>)[\s\S]*(</head>)","")
' remove all scripts (prepare first by clearing attributes)
Result_text = ReplaceText(Result_text,"<( )*script([^>])*?>","<script>")
Result_text = ReplaceText(Result_text,"(<( )*(/)( )*?script()*>)","</script>")
Result_text = ReplaceText(Result_text,"(<script>)([^(<script>\.</script>)])*?(</script>)","")
Result_text = ReplaceText(Result_text,"(<script>)[\s\S]*?(</script>)","")
' remove all styles (prepare first by clearing attributes)
Result_text = ReplaceText(Result_text,"<( )*style([^>])*?>","<style>")
Result_text = ReplaceText(Result_text,"(<( )*(/)( )*?style( )*>)","</style>")
Result_text = ReplaceText(Result_text,"(<style>)[\s\S]*?(</style>)","")
' prepare spans by first clearing attributes
Result_text = ReplaceText(Result_text,"<( )*span([^>])*?>","<span>")
Result_text = ReplaceText(Result_text,"(<( )*(/)( )*?span( )*>)","</span>")
' insert tabs in spaces of <td> tags
Result_text = ReplaceText(Result_text,"<( )*td([^>])*>","\t")
' insert line breaks in places of <BR> and <LI> tags
Result_text = ReplaceText(Result_text,"<( )*br( )*>","\r\r")
Result_text = ReplaceText(Result_text,"<( )*li( )*>","\r\r")
' insert line paragraphs (double line breaks) in place if <P>, <DIV> and <TR> tags
Result_text = ReplaceText(Result_text,"<( )*div([^>])*>","\r\r")
Result_text = ReplaceText(Result_text,"<( )*tr([^>])*>","\r\r")
Result_text = ReplaceText(Result_text,"<( )*p([^>])*>","\r\r")
' Remove remaining tags like <a>, links, images, comments etc - anything thats enclosed inside < >
Result_text = ReplaceText(Result_text,"<[\s\S]*?>","")
' replace special characters:
Result_text = ReplaceText(Result_text,"•"," * ")
Result_text = ReplaceText(Result_text,"‹","<")
Result_text = ReplaceText(Result_text,"›",">")
Result_text = ReplaceText(Result_text,"™","(tm)")
Result_text = ReplaceText(Result_text,"⁄","/")
Result_text = ReplaceText(Result_text,"<","<")
Result_text = ReplaceText(Result_text,">",">")
Result_text = ReplaceText(Result_text,"©","(c)")
Result_text = ReplaceText(Result_text,"®","(r)")
' make line breaking consistent
Result_text = Replace(Result_text,"\n","\r")
' Remove extra line breaks and tabs:
' Prepare first to remove any whitespaces inbetween
' the escaped characters and remove redundant tabs inbetween linebreaks
Result_text = ReplaceText(Result_text,"(\r)( )+(\r)","\r\r")
Result_text = ReplaceText(Result_text,"(\t)( )+(\t)","\t\t")
Result_text = ReplaceText(Result_text,"(\t)( )+(\r)","\t\r")
Result_text = ReplaceText(Result_text,"(\r)( )+(\t)","\r\t")
' Remove redundant tabs
Result_text = ReplaceText(Result_text,"(\r)(\t)+(\r)","\r\r")
' Remove multible tabs followind a linebreak with just one tab
Result_text = ReplaceText(Result_text,"(\r)(\t)+","\r\t")
' Initial replacement target string for linebreaks
breaks = "\r\r"
' Initial replacement target string for tabs
tabs = "\t\t\t"
for i=0 to 5
Result_text = Replace(Result_text, breaks, vbcrlf)
Result_text = Replace(Result_text, tabs, "")
Result_text = Replace(Result_text, vbcrlf & vbcrlf & vbcrlf, vbcrlf & vbcrlf)
next 'i
Result_text = Replace(Result_text, " ", "")
' Thats it.
StripHTML = Result_Text
End Function
Function ReplaceText(str1, patrn, replStr)
Dim regEx
Set regEx = New RegExp
with regEx
.Pattern = patrn
.IgnoreCase = True
.Global = True
end with
ReplaceText = regEx.Replace(str1, replStr)
End Function