To quarantine application file attachments

This Outlook VBA code sample monitors the Inbox folder for new items, looks for messages with attached files with the extensions listed in the USER OPTIONS section, and moves such messages to an Inbox\Quarantine folder for later review, creating the folder if it doesn't exist. Place this code in the ThisOutlookSession module so that it runs when Outlook starts.

Code Sample

Private WithEvents olInboxItems As Items Private Sub Application_Startup() Dim objNS As NameSpace Set objNS = Application.GetNamespace("MAPI") Set olInboxItems = objNS.GetDefaultFolder(olFolderInbox).Items Set objNS = Nothing End Sub Private Sub olInboxItems_ItemAdd(ByVal Item As Object) Dim objAttFld As MAPIFolder Dim objInbox As MAPIFolder Dim objNS As NameSpace Dim strAttFldName As String Dim strProgExt As String Dim arrExt() As String Dim objAtt As Attachment Dim intPos As Integer Dim I As Integer Dim strExt As String ' #### USER OPTIONS #### ' name of Inbox subfolder containing messages with attachments strAttFldName = "Quarantine" ' delimited list of extensions to trap strProgExt = "exe, bat, com, vbs, vbe" On Error Resume Next Set objNS = Application.GetNamespace("MAPI") Set objInbox = objNS.GetDefaultFolder(olFolderInbox) Set objAttFld = objInbox.Folders(strAttFldName) If Item.Class = olMail Then If objAttFld Is Nothing Then ' create folder if needed Set objAttFld = objInbox.Folders.Add(strAttFldName) End If If Not objAttFld Is Nothing Then ' convert delimited list of extensions to array arrExt = Split(strProgExt, ",") For Each objAtt In Item.Attachments intPos = InStrRev(objAtt.FileName, ".") If intPos > 0 Then ' check attachment extension against array strExt = LCase(Mid(objAtt.FileName, intPos + 1)) For I = LBound(arrExt) To UBound(arrExt) If strExt = Trim(arrExt(I)) Then Item.Move objAttFld Exit For End If Next Else ' no extension; unknown type Item.Move objAttFld End If Next End If End If On Error GoTo 0 Set objAttFld = Nothing Set objInbox = Nothing Set objNS = Nothing Set objAtt = Nothing End Sub

Notes

This code is no substitute for a good virus scanner.

In most versions of Outlook, application file types such as .exe are already blocked by the Outlook Email Security Update, so this code won't have any effect.

You could adapt this technique to detect files of any particular type and perform specific processing on them. Don't forget that you must save an attachment first (Attachment.SaveAsFile) before you can access it with the methods appropriate for that file's application.

More Information

Viruses Affecting Microsoft Outlook
To convert incoming HTML messages to Outlook Rich Text format -- another code sample for the Inbox


	© 2002-7 TurtleFlock, LLC All right reserved. About OutlookCode.com Send comments to webmaster@outlookcode.com Designed and Implemented by TerraLink USA FrontPage Integration by RobsonDesignWorks


get Sue's code \| forums \| share your own code \| registration