You could define a function SaveAttachments and call from the OnDeliverMessage event
Sub OnDeliverMessage(oMessage)
call SaveAttachments(oMessage)
End Sub
''''''''''''''''
Sub SaveAttachments(oMessage)
' this routine saves file attachments that have the specified
' FileExtensions.
Dim SaveFolder 'where to store attachments. This folder must already exist.
SaveFolder = "c:\path_to_folder\" ' trailing slash is required
Dim SavedFile
Dim FileExtensions ' set to the file attachment extensions you want to save
FileExtensions = "(pdf|doc)"
Dim oAttachment
Dim oRegExp
Set oRegExp = new RegExp
For oAttachment = 0 to oMessage.Attachments.Count-1
' Test for specified attachments
with oRegExp
.Pattern = "^.*\."& FileExtensions & "$"
.IgnoreCase = True
.Global = False
end with
if (oRegExp.test(oMessage.Attachments(oAttachment).Filename)) Then
SavedFile = SaveFolder & Left(Right(oMessage.Filename,42),38) & "." & oAttachment & "." & oMessage.Attachments(oAttachment).Filename
oMessage.Attachments(oAttachment).SaveAs(SavedFile)
' uncomment below to Delete Attachment from message
'oMessage.Attachments(oAttachment).Delete
End If
Next
Set oRegExp = nothing
End Sub