Авто сохранение вложений из входящих писем на сетевой диск

Sub Initialize
Dim session As New NotesSession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Dim rtitem As Variant
Dim attachname As String
Dim filename As String
Dim body As NotesRichTextItem
Dim emphasize As NotesRichTextStyle
 
Set db = session.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
Set rtitem = doc.GetFirstItem( "Body" )
 
If ( rtitem.Type = RICHTEXT ) Then
Forall obj In rtitem.EmbeddedObjects
If ( obj.Type = EMBED_ATTACHMENT ) Then
Set emphasize = session.CreateRichTextStyle
emphasize.Bold = True
emphasize.NotesColor = COLOR_RED
Set body = doc.GetFirstItem("Body")
Call rtitem.AddNewLine( 2 )
Call body.AppendStyle(emphasize)
attachname = obj.source
Call obj.ExtractFile
( "\\
QDSWJDE1AMstarUnProcessed\"
& attachname )
 
Call rtitem.AddNewLine( 2 )
Call rtitem.AppendText(( "Your file was
downloaded to\
\QDSWJDE1AMstarUnProcessed
as filename: " ) &
attachname)
Call doc.Save( False, True )
 
End If
End Forall
End If
End Sub