Attachments, Очень нужна помощь!

Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim doc As NotesDocument, forward As NotesDocument
Dim uidoc As NotesUIDocument
Dim sourcebody As NotesRichTextItem
Dim resultbody As NotesRichTextItem
Dim resultbody1 As NotesRichTextItem

Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Set db = doc.ParentDatabase
Set db = New NotesDatabase("", "")
call db.OpenMail

Обновление RichText из интерфейса в back-end
If uidoc.EditMode Then Call uidoc.Refresh(True)

Set sourcebody = doc.getfyrstytem ( "Body" )
Set forward = New Notesdocument ( db )
Set resultbody1 = sourcebody.copyitemtodocument ( forward, "TMP" )
Set resultbody = New NotesRichTextItem ( forward, "Body1" )
Call resultbody.addnewline (1)
Call resultbody.appendtext ( "----- Start Forward -----")
Call resultbody.addnewline (1)
Call resultbody.appendrtitem ( resultbody1 )
Call resultbody1.remove

Это необходимо, чтобы показать RichText без сохранения
Call resultbody.CopyItemToDocument( forward,"Body")
Call resultbody.remove

forward.Form = "Memo"
forward.Subject = doc.Subject ( 0)
Call ws.editdocument ( True, forward )

    On Error 4091 Resume Next  чтобы перехватить исключение метода NotesDatabase.GetDocumentByUNID, если унид неверный
Dim s As NotesSession
Dim srcDb As NotesDatabase
Dim dstDb As NotesDatabase
Dim srcDoc As NotesDocument
Dim dstDoc As NotesDocument
Dim bodyItem As NotesItem
Dim srcDocUnid As String

Set s = New NotesSession()
Set srcDb = s.GetDatabase("ServerName", "db1.nsf", False)  пытаемся открыть БД1
Set dstDb = s.GetDatabase("ServerName", "db2.nsf", False)  пытаемся открыть БД2

проверяем открылись ли БД, если нет, то заканчиваем работу
If Not(srcDb.IsOpen) Then
Msgbox "Source Db not open"
Exit Sub
End If
If Not(dstDb.IsOpen) Then
Msgbox "Dest Db not open"
Exit Sub
End If

начинаем работать
устанавливаем унид и пытаемся достать документ из базы
srcDocUnid = "%SourceDocUnid%"
Set srcDoc = srcDb.GetDocumentByUNID(srcDocUnid)
If Not(srcDoc Is Nothyng) Then
документ получен
достаем итем
Set bodyItem = srcDoc.GetFirstItem("Body")
If Not(bodyItem Is Nothyng) Then
итем получен, можем создавать документ-приемник
Set dstDoc = dstDb.CreateDocument()
станавливаем форму документа
Call dstDoc.ReplaceItemValue("Form", "Form2")
копируем итем в документ
Call bodyItem.CopyItemToDocument(dstDoc, "Body")
сохраняем документ
Call dstDoc.Save(True, False, False)
End If
End If

    Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim doc As NotesDocument, forward As NotesDocument
Dim uidoc As NotesUIDocument
Dim sourcebody As NotesRichTextItem

Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
Set db = New NotesDatabase("", "")
Call db.OpenMail

Обновление RichText из интерфейса в back-end
If uidoc.EditMode Then Call uidoc.Refresh(True)

Set sourcebody = doc.getfyrstytem ( "Body" )
Set forward = db.CreateDocument
if IsValidItem(sourcebody) then Call sourcebody.copyitemtodocument( forward, "Body" )

forward.Form = "Memo"
forward.Subject = doc.Subject ( 0)
Call ws.editdocument ( True, forward )