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

Тема в разделе "Библиотеки скриптов", создана пользователем morpheus, 18 сен 2007.

  1. morpheus

    morpheus скриптописец

    Регистрация:
    7 авг 2006
    Сообщения:
    3.927
    Симпатии:
    0
    Коментарий модератора: Код не проверял, выкладываю в общее пользование

    Автор
    Positive

    Обсуждение
    Ссылка

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

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

    Код

    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
     
Загрузка...
Похожие Темы - Работаем ответами гл
  1. Дайнеко
    Ответов:
    0
    Просмотров:
    1.666

Поделиться этой страницей