Sub Click(Source As Button)
Dim ws As New NotesUIWorkspace
Dim ses As New NotesSession
Dim db As NotesDatabase
Dim spravdb As New NotesDatabase("","")
Dim strdb As New NotesDatabase("","")
Dim uidoc As NotesUIDocument
Dim coll As NotesDocumentCollection
Dim view As NotesView
dim rtFotoSrc as NotesRichTextItem
dim rtFotoDst as NotesRichTextItem
Set db = ses.CurrentDatabase
Set uidoc = ws.CurrentDocument
If Not uidoc.EditMode Then
Msgbox "Документ должен быть открыт для редактирования"
Exit Sub
End If
sServer=ses.GetEnvironmentString("SpravInfServer")
sDb = "telsprav.nsf"
If Not spravdb.OpenWithFailover( sServer,sDb ) Then
Msgbox "База данных ""Телефонный Справочник"" не найден.", 16,"Ошибка..."
Exit Sub
End If
Set coll=ws.PickListCollection(3,False,sServer,sDb,"Podr","Список сотрудников","Выберите","")
if coll.Count > 0 then
Set someDoc = coll.GetFirstDocument
uidoc.Document.ReplaceItemValue("Fam", someDoc.GetItemValue("fam"))
uidoc.Document.ReplaceItemValue("Name", someDoc.GetItemValue("Name"))
uidoc.Document.ReplaceItemValue("Otch", someDoc.GetItemValue("Otch"))
uidoc.Document.ReplaceItemValue("Dolj", someDoc.GetItemValue("dolj"))
uidoc.Document.ReplaceItemValue("Otdel", someDoc.GetItemValue("Otdel"))
uidoc.Document.ReplaceItemValue("Podraz", someDoc.GetItemValue("Podraz"))
Set rtFotoSrc = someDoc.GetFirstItem("Foto")
' из приемника берем RTI, если он не существует, то создаем
Set rtFotoDst = uidoc.Document.GetFirstItem("Foto")
If rtFotoDst Is Nothing Then
Set rtFotoDst = uidoc.Document.CreateRichTextItem("Foto")
End If
' и добавляем источник
Call rtFotoDst.AppendRTItem(rtFotoSrc)
' "прописываем" изменения в приемнике
Call rtFotoDst.Update
' тут указывается форма документа, т.к. он был новый и форма не установлена еще
Call uidoc.Document.ReplaceItemValue("Form", "СЮДА НАДО ВПИСАТЬ ИМЯ ФОРМЫ, А ЛУЧШЕ АЛИАС")
' теперь открываем приемник в новом окне
Call ws.EditDocument(True, uidoc.Document)
' это позволяет избавиться от вопроса о сохранении закрываемого документа!
Call uidoc.Document.ReplaceItemValue("SaveOptions", "0")
' закрываем "старый" приемник
Call uidoc.Close(True)
end if
End Sub