Delete mail containing certain attachment types and store in global mail file

This script should be run by agent and it should be scheduled (before new mail). This agent should reside in the user's mail file. It checks for certain type attachments in the mail and deletes from the user's mail file and copied to global mail file. Create a user as global user to use his mail file as global mail file.

Code

On Error Goto ErrRt 
Dim Session As New notessession
Dim DB As notesdatabase 
Dim Doc As notesdocument
Dim AttachItem As notesembeddedobject
Dim  FindStr As Variant
Dim AttachSource As String
Dim FileName As Variant
Dim Body, TempSendTo As Variant
Dim emphasize As NotesRichTextStyle

Set emphasize = Session.CreateRichTextStyle
emphasize.Bold = True
emphasize.NotesColor = COLOR_RED
 
Set DB = Session.currentdatabase
Set Doc = Session.documentcontext 
Set FindStr = Doc.getfirstitem("body") 
Forall Att In Doc.items
If (Att.Type = ATTACHMENT) Then
Set Attachitem = Doc.GetAttachment(Att.Values(0))
FileName = Lcase(Attachitem.source)
 
'* Checking for File Types.   
If Right(FileName,3) = "vbs" Or Right(FileName,3) = "vbe" Or Right(FileName,3) = "pif" Or Right(FileName,3) = "jpg" Or Right(FileName,3) = "bmp" Or Right(FileName,3) = "scr" Or Right(FileName,3) = "exe" Or Right(FileName,3) = "avi" Or Right(FileName,3) = "mpg" Or Right(FileName,3) = "mpeg" Or Right(FileName,3) = "mp3" Then
    
'** To Copy document with Attachment into BackUp mail file        
TempSendto = Doc.getitemvalue("SendTo")
doc.SendTo = "Tmail"
doc.Subject = "Copy of mail with Attachment  : " & FileName

Call doc.Send( False )
doc.SendTo = TempSendTo(0)
'** Removing Attachment from Master Document
    
Call Attachitem.remove       
Set Body = Doc.getfirstitem("body")
Call Body.AddNewLine(1)
Call Body.AddNewLine(1)
Call Body.AppendStyle(emphasize)
Call Body.AppendText("Warning :")
Call Body.AddNewLine(1)
Call Body.AppendText("The following file has been deleted out of this email by a virus checking procedure : " & filename &".")
Call Body.AddNewLine(1)
Call Body.AddNewLine(1)
Call Body.AppendText("Please contact Notes Administrator.")     
End If     
End If  
End Forall
ErrRt:
Print "Error " & Erl & ": " & Error$
Exit Sub