Работаем с ответами и гл. документами

[morpheus]

Коментарий модератора: Код не проверял, выкладываю в общее пользование

Автор

Ссылка скрыта от гостей

Обсуждение

Ссылка скрыта от гостей

Универсальные процедурки для работы с гл.доком и его деревом ответов.

Создаем библиотечку.

Код

Declarations

Dim s As NotesSession
Dim db As NotesDatabase
Dim archivedoc As NotesDocument
Dim maindoc As NotesDocument
Dim ArrayDocs() As String
Dim i As Integer
Dim curdb As NotesDatabase

Sub Initialize
i=0
Redim ArrayDocs(i)
If s Is Nothing Then Set s=New NotesSession
Set curdb=s.CurrentDatabase
End Sub


Sub TreeResponses(MainDb As NotesDatabase,DocUnid As String )
' Процедура для обработки гл. документа и дерева документов-ответов.
' Является главной в библиотеке.
' В результате исполнения процедуры, выстраивается массив UNID документов, где нулевое значение
' это UNID гл.документа
Dim tmaindoc As NotesDocument
Dim trespdoc As NotesDocument
Dim trrespdoc As NotesDocument
Dim trespdc As NotesDocumentCollection
Dim rrespdc As NotesDocumentCollection
If s Is Nothing Then Set s=New NotesSession
Set tmaindoc=maindb.GetDocumentByUNID(docunid)
If Not tmaindoc Is Nothing Then
ArrayDocs(i)=Docunid
Call tmaindoc.Save(True,False)
Set trespdc=tmaindoc.Responses
Set trespdoc=trespdc.GetFirstDocument
While Not trespdoc Is Nothing
i=i+1
Redim Preserve ArrayDocs(i)
ArrayDocs(i)=trespdoc.UniversalID
Call trespdoc.Save(True,False)
Set rrespdc=trespdoc.Responses
If rrespdc.Count>0 Then Call TreeResponses(maindb,trespdoc.UniversalID)
Set trespdoc=trespdc.GetNextDocument(trespdoc)
Wend
End If
End Sub


Sub SyncroniseFieldInTreeResponses(DocUnid As String,FieldName As String)
' Процедура выполняет синхронизацию поля FieldName гл.документа, со всеми документами-ответами в дереве
If s Is Nothing Then Set s=New NotesSession
Call TreeResponses(curdb,DocUnid)
Dim docfield As NotesDocument
Set docfield=curdb.GetDocumentByUNID(ArrayDocs(0))
Dim FieldValue As Variant
If Not docfield Is Nothing Then
FieldValue=docField.GetItemValue(FieldName)
Forall F In ArrayDocs
Set maindoc=curdb.GetDocumentByUNID(F)
If Not maindoc Is Nothing Then
Call maindoc.ReplaceItemValue(FieldName,FieldValue)
Call maindoc.Save(True,False)
End If
End Forall
End If
End Sub


Sub SyncroniseFieldListInTreeResponses(DocUnid As String,FieldList List As String)
' Процедура записывает в гл. документ и во все документы ответы в дереве, значания полей, перечисленных в FieldList
If s Is Nothing Then Set s=New NotesSession
Call TreeResponses(curdb,DocUnid)
Dim docfield As NotesDocument
Set docfield=curdb.GetDocumentByUNID(ArrayDocs(0))
Dim FieldName As Variant
Dim FieldValue As Variant
If Not docfield Is Nothing Then
Forall F In ArrayDocs
Set maindoc=curdb.GetDocumentByUNID(F)
If Not maindoc Is Nothing Then
Forall k In FieldList
FieldName=Listtag(k)
FieldValue=FieldList(Listtag(k))
Call maindoc.ReplaceItemValue(FieldName,FieldValue)
Call maindoc.Save(True,False)
End Forall
End If
End Forall
End If
End Sub

Sub ArchiveDocsInTreeResponses(MainDb As NotesDatabase,ArchiveDb As NotesDatabase,DocUnid As String)
' Процедура архивирования (перенесения в архивную копию) гл. документа и документов-ответов
If s Is Nothing Then Set s=New NotesSession
If ArchiveDb.IsOpen Then
Dim view As NotesView
Set view=archivedb.GetView("UNIDS")
If view Is Nothing Then Exit Sub
Call TreeResponses(maindb,DocUnid)
Forall F In ArrayDocs
Set maindoc=curdb.GetDocumentByUNID(F)
If Not maindoc Is Nothing Then
Call view.Refresh
If view.GetDocumentByKey(Cstr(F)) Is Nothing Then
Set archivedoc=archivedb.CreateDocument
Call maindoc.CopyAllItems(archivedoc)
archivedoc.UniversalID=maindoc.UniversalID
Call archivedoc.Save(True,False)
Call view.Refresh
If Not view.GetDocumentByKey(Cstr(F)) Is Nothing Then
Call maindoc.Remove(True)
End If
Else
maindoc.needcopytoarchive="1"
Call maindoc.Save(True,False)
End If
End If
End Forall
Else
Exit Sub
End If
End Sub



Пример использования

Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant) continue=False
Dim trashenable As Variant
trashenable=Evaluate({@IsMember("[trash]";@UserRoles)})
If trashenable(0)=1 Then
Dim doc As NotesDocument
Dim dc As NotesDocumentCollection
Set dc=source.Documents
If dc.Count>0Then
Dim uiview As NotesUIView
Dim ws As New NotesUIWorkspace
Set uiview=ws.CurrentView
If uiview.View.Name<>"(trash)" Then
If Messagebox ("Вы действительно хотите удалить выделенные документы в корзину?",4+32, "Внимание")=6 Then
Set doc=dc.GetFirstDocument
While Not doc Is Nothing
Dim FieldList List As String
FieldList("trash")="1"
Call SyncroniseFieldListInTreeResponses(doc.UniversalID,FieldList)
Set doc=dc.GetNextDocument(doc)
Wend
Call ws.ViewRefresh
End If
Else
If Messagebox ("Вы действительно хотите удалить выделенные документы из базы данных?",4+32, "Внимание")=6 Then
continue=True
End If
End If
End If
Else
Messagebox "Вам запрещено удалять документы в данной БД", 0+16, "Внимание"
End If
End Sub