Dim reviewCol As NotesDocumentCollection
Dim reviewDoc As NotesDocument
Dim ws As New NotesUIWorkspace
Dim reviewdb As NotesDatabase, db As NotesDatabase
Set reviewdb = ws.currentDatabase.Database
Dim doc As NotesDocument,docB As NotesDocument
Dim i As Long
Dim uidoc As NotesUIDocument
Dim revvid() As String
Set db = ws.CurrentDatabase.Database
Dim note As NotesDocument, docs As NotesDocument
Dim rtitem As Variant,rtitem1 As Variant
'Dim docs As NotesDocumentCollection
Dim skServ As String,skServ1 As String
Dim skServint As Variant
Set reviewDoc = ws.CurrentDocument.Document
Set uidoc= ws.CurrentDocument
Set note = uidoc.Document
Set reviewCol= ws.PickListCollection(PICKLIST_CUSTOM, True, "RB/Rb/RU","intra-design\Procedure.nsf " , "stru2", "Выбор процедуры", "Выберите нужные процедуры" )
Dim db1 As New NotesDatabase( "RB/Rb/RU", "intra-design\Procedure.nsf " )
Dim collection As NotesDocumentCollection
Dim item As NotesItem
Dim view As NotesView
Dim skServs() As Variant
Dim dateTime As New NotesDateTime( "" )
'''''''''''''''''рассматриваем первую коллекцию
If reviewCol.count = 0 Then Exit Sub
reviewDoc.tasks= ""
Redim revvid(max)
revvid(0)=""
For i = 1 To reviewCol.count
Set doc = reviewCol.GetNthDocument(i)
skServ= doc.GetItemValue("k1")(0) '''''''берем значение номера шаблона
Set view=db1.GetView("(All1)")
Set collection= view.GetAllDocumentsByKey(skServ, False)
'''''рассматриваем вторую коллекцию и создаем новые доки в текущей базе
Set docs = collection .GetFirstDocument()
While Not(docs Is Nothing)
' Call reviewCol.addDocument(docs)
Set docB = New NotesDocument( db )
Call docB.AppendItemValue( "Form", "works" )
Call docB.AppendItemValue( "order_id", reviewDoc.order_id(0) )
Call docB.AppendItemValue( "member_name", reviewDoc.member_name )
Call docs.CopyAllItems(docB, False)
If docs.HasItem("Body") Then
Set rtitem = docs.GetFirstItem("Body")
docB.RemoveItem("Body")
Call rtitem.CopyItemToDocument(docB, "Body")
Set rtitem1= New NotesRichTextItem( docB, "Body1" )
Call rtitem1.AppendDocLink( docs, db.Title)
Else
docs.CopyBody = True
End If
Call docB.Save(True,True,True)
Set docs = collection.GetNextDocument(docs)
Wend
'''''''далее обрабатываем первую коллекцию
If max >0 Or revvid(0) <> "" Then
max = max +1
Redim Preserve revvid (max)
End If
If Not doc.HasItem("ProcName") Then
revvid (max) = "нет процедуры"
Elseif doc.ProcName(0) ="" Then
revvid (max) = "нет процедуры"
Else
revvid (max) = doc.ProcName(0)
End If
'''''по ней так же создаем документы
Set docB = New NotesDocument( db )
Call docB.AppendItemValue( "Form", "works" )
Call docB.AppendItemValue( "order_id", reviewDoc.order_id(0) )
Call docB.AppendItemValue( "member_name", reviewDoc.member_name)
Call doc.CopyAllItems(docB, False)
If doc.HasItem("Body") Then
Set rtitem = doc.GetFirstItem("Body")
docB.RemoveItem("Body")
Call rtitem.CopyItemToDocument(docB, "Body")
Set rtitem1= New NotesRichTextItem( docB, "Body1" )
Call rtitem1.AppendDocLink( doc, db.Title)
Else
doc.CopyBody = True
End If
Call docB.Save(True,True,True)
Next
reviewDoc.tasks= revvid
Set doc = reviewCol.GetNextDocument( doc )
Exit Sub
Эта одна из вариаций кода.Пробавала вместо создания новых документов в рассмотрении второй коллекции запихнуть документы из нее в первую.
Уже совсем перестала петрить в чем тут заковырка. :wacko:
