Philip,
I use the following code which includes at least what you
want and a good deal more. It moves all receipts into a
saved folder and marks all e-mails with enclosures having
a .EXE extension into the Infected folder.:
Option Compare Text
Private Sub Application_Startup()
'MsgBox ("Starting up!!")
' Check new mail in case anything arrived overnight.
Application_NewMail
End Sub
Private Sub Application_NewMail()
'MsgBox ("New Mail!!")
Set msOutlook = Application.GetNamespace("MAPI")
' Get a handle onto the inbox.
Set inbox = msOutlook.GetDefaultFolder(olFolderInbox)
' And to the saved receipts folder.
Set savedReceipts = inbox.Parent.Folders
("Saved").Folders("Receipts")
' And the infected folder.
Set infected = inbox.Parent.Folders("Infected")
' Look through the items.
For Each thisItem In inbox.Items
' Dont bother with already read ones.
If thisItem.UnRead Then
' Look for receipts.
If TypeName(thisItem) = "ReportItem" Then
' Could be a receipt.
If (thisItem Like "Read:*" Or thisItem
Like "Not Read:*" Or thisItem Like "Delivered:*") Then
' Receipt! Mark it as read.
thisItem.UnRead = False
' Move it to my saved receipts folder.
thisItem.Move savedReceipts
End If
ElseIf TypeName(thisItem) = "MailItem" Then
' Check the normal mail items for
enclosures.
Dim moveIt As Boolean
moveIt = False
' Look for .EXE enclosures.
For Each attachment In thisItem.Attachments
' MsgBox ("Enclosure: " +
attachment.DisplayName)
' .exe attachments are a real giveaway.
If attachment.DisplayName Like "*.exe"
Then
' Get rid of this one.
moveIt = True
End If
Next attachment
' Look for 'EMAIL SCAN:' items.
If thisItem Like "EMAIL SCAN:*" Then
moveIt = True
' Move it if needed
If moveIt Then
' Infected item! Mark it as read.
thisItem.UnRead = False
' Move it.
thisItem.Move infected
' Clean up
'inbox.UnReadItemCount =
inbox.UnReadItemCount - 1
' MsgBox ("Infected Item Moved! " +
thisItem)
End If
End If
End If
' Next one.
Next thisItem
' Walk through Infected, marking all as read.
For Each thisItem In infected.Items
' Dont bother with already read ones.
If thisItem.UnRead Then
' Mark it as read.
thisItem.UnRead = False
End If
' Next one.
Next thisItem
End Sub
Unfortunately, it doesnt clear the little 'You have unread
messages' icon in my taskbar. Anyone know how to refresh
this annoying little dohickey?
Paul