hunkman said:
I would like to delete/filter all messages that have HREF=HTTP in the
message source. Does anyone have any script that looks for a specific
word(s) in Outlook 2000 message source and then either raises a flag
or performs a specific action (such as moving/deleting the message)?
Any help would be appreciated.
Go to Tool->Macros->Visual Basic Editor (ALT+F11) then drop this lot in.
Feel free to change it, of course.
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 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 & "o"
ElseIf tmpSubject = "0" Then
tmpSubject = tmpSubject & "o"
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 Len(Item.Subject) = 0 Then
Item.Move objJunkFolder
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, "cialis", 1) <> 0 Or _
InStr(1, strSubject, "credit", 1) <> 0 Or _
InStr(1, strSubject, "discount", 1) <> 0 Or _
InStr(1, strSubject, "doctor", 1) <> 0 Or _
InStr(1, strSubject, "drug", 1) <> 0 Or _
InStr(1, strSubject, "erotic", 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, "meds", 1) <> 0 Or _
InStr(1, strSubject, "money", 1) <> 0 Or _
InStr(1, strSubject, "mortgage", 1) <> 0 Or _
InStr(1, strSubject, "orgy", 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, "pussy", 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, "teens", 1) <> 0 Or _
InStr(1, strSubject, "vacation", 1) <> 0 Or _
InStr(1, strSubject, "viagra", 1) <> 0 Or _
InStr(1, strSubject, "weight", 1) <> 0 Or _
InStr(1, strSubject, "xanax", 1) <> 0 Then
Item.Move objJunkFolder
End If
Set Item = Nothing
End Sub
