Detecting HTML in Outlook 2000

[Sparkplug]

People keep saying that you can't detect HTML messages in Outlook 2000. But
there is a way. What follows is some VB that does the trick. Select
Tools->Macro->Visual Basic Editor and drop the code in.

It requires two folders called "Attachments", "Junk" and "HTML Messages" as
children of default Inbox folder. There is some rudimentary spam detection
in the code as well, but I also have Norton running so it's not really
important.

You should also make sure that Preview Pane and AutoPreview are turned off
on the new folders, because reading the message usually downloads one or
more images, even if thay are just 1x1 pixels. This request to their server
tells the spammer that the message was received and confirms your address.
They can then spam you again and sell your address to others.

Share and Enjoy


Option Explicit

Public WithEvents olInboxItems As Outlook.Items

Dim objInboxFolder As MAPIFolder
Dim objAttachmentsFolder As MAPIFolder
Dim objHTMLFolder As MAPIFolder
Dim objJunkFolder As MAPIFolder

Private Sub Application_Startup()

Set objInboxFolder = Application.Session.GetDefaultFolder(olFolderInbox)

Set objAttachmentsFolder = objInboxFolder.Folders("Attachments")

Set objHTMLFolder = objInboxFolder.Folders("HTML Messages")

Set objJunkFolder = objInboxFolder.Folders("Junk")

Set olInboxItems = objInboxFolder.Items

End Sub

Private Sub Application_Quit()

Set objInboxFolder = Nothing

Set objHTMLFolder = Nothing

Set objJunkFolder = Nothing

End Sub

Private Sub olInboxItems_ItemAdd(ByVal Item As Object)

Dim strSubject As String
Dim tmpSubject As String
Dim tmpChar As String
Dim ascValue As Integer

Dim i As Integer

strSubject = LCase(Item.Subject)

For i = 1 To Len(strSubject)

tmpChar = Mid(strSubject, i, 1)

ascValue = Asc(tmpChar)

If ascValue >= 97 And ascValue <= 122 Or tmpChar = " " Then

tmpSubject = tmpSubject & tmpChar

ElseIf ascValue >= 224 And ascValue <= 229 Then

tmpSubject = tmpSubject & "a"

ElseIf ascValue >= 232 And ascValue <= 235 Then

tmpSubject = tmpSubject & "e"

ElseIf ascValue >= 236 And ascValue <= 239 Then

tmpSubject = tmpSubject & "i"

ElseIf ascValue = 241 Then

tmpSubject = tmpSubject & "n"

ElseIf ascValue >= 242 And ascValue <= 246 Then

tmpSubject = tmpSubject & "o"

ElseIf ascValue = 248 Then

tmpSubject = tmpSubject & "0"

ElseIf ascValue >= 249 And ascValue <= 252 Then

tmpSubject = tmpSubject & "u"

ElseIf tmpChar = "@" Then tmpSubject = tmpSubject & "a"

ElseIf tmpChar = "1" Then tmpSubject = tmpSubject & "i"

ElseIf tmpChar = "|" Then tmpSubject = tmpSubject & "i"

End If

Next i

strSubject = tmpSubject

If Item.Attachments.Count <> 0 Then

Item.Move objAttachmentsFolder

ElseIf Item.GetInspector.EditorType = olEditorHTML Then

Item.Move objHTMLFolder

ElseIf _
InStr(1, strSubject, "boost", 1) <> 0 Or _
InStr(1, strSubject, "cash", 1) <> 0 Or _
InStr(1, strSubject, "cheap", 1) <> 0 Or _
InStr(1, strSubject, "credit", 1) <> 0 Or _
InStr(1, strSubject, "discount", 1) <> 0 Or _
InStr(1, strSubject, "drug", 1) <> 0 Or _
InStr(1, strSubject, "fantasy", 1) <> 0 Or _
InStr(1, strSubject, "financ", 1) <> 0 Or _
InStr(1, strSubject, "extra", 1) <> 0 Or _
InStr(1, strSubject, "free", 1) <> 0 Or _
InStr(1, strSubject, "girl", 1) <> 0 Or _
InStr(1, strSubject, "inches", 1) <> 0 Or _
InStr(1, strSubject, "income", 1) <> 0 Or _
InStr(1, strSubject, "invest", 1) <> 0 Or _
InStr(1, strSubject, "loan", 1) <> 0 Or _
InStr(1, strSubject, "love", 1) <> 0 Or _
InStr(1, strSubject, "meds", 1) <> 0 Then

Item.Move objJunkFolder

ElseIf _
InStr(1, strSubject, "medic", 1) <> 0 Or _
InStr(1, strSubject, "money", 1) <> 0 Or _
InStr(1, strSubject, "mortgage", 1) <> 0 Or _
InStr(1, strSubject, "pharm", 1) <> 0 Or _
InStr(1, strSubject, "pill", 1) <> 0 Or _
InStr(1, strSubject, "prescrip", 1) <> 0 Or _
InStr(1, strSubject, "price", 1) <> 0 Or _
InStr(1, strSubject, "rates", 1) <> 0 Or _
InStr(1, strSubject, "sex", 1) <> 0 Or _
InStr(1, strSubject, "spam", 1) <> 0 Or _
InStr(1, strSubject, "stamina", 1) <> 0 Or _
InStr(1, strSubject, "vacation", 1) <> 0 Or _
InStr(1, strSubject, "viagra", 1) <> 0 Or _
InStr(1, strSubject, "weight", 1) <> 0 Then

Item.Move objJunkFolder

End If

Set Item = Nothing

End Sub

 

[marx404]

thanks! I have seen a link to something like this at slipstick.com before.
good to know it actually works.

marx404

 

[Milly Staples [MVP - Outlook]]

You mean this page:
http://www.outlookcode.com/d/code/zaphtml.htm

--
Milly Staples [MVP - Outlook]

Post all replies to the group to keep the discussion intact. Due to
the (insert latest virus name here) virus, all mail sent to my personal
account will be deleted without reading.

After searching google.groups.com and finding no answer, marx404 asked:

| thanks! I have seen a link to something like this at slipstick.com
| before. good to know it actually works.
|
| marx404