Отправить группу документов админом

Sub Click(Source As Button)
    Dim ws As New NotesUIWorkspace
    Dim uiview As NotesUIView
    Dim dc1 As NotesDocumentCollection
    Dim session As New NotesSession
    Dim view As NotesView
    Dim db As NotesDatabase, strukdb As notesdatabase
    Dim dc As NotesDocumentCollection, strukdc As NotesDocumentCollection
    Dim curdoc As NotesDocument, docreg As NotesDocument, ftdoc As notesdocument,  strukdoc As NotesDocument
    Dim mes As String, mes2 As String, mes3 As String, who As String, server As String, user As String, shadow1 As String, shadow2 As String
    Dim flag As Boolean
    Dim picklist As Variant, sdate As Variant
    Dim item As NotesItem, item2 As NotesItem, item3 As NotesItem, item4 As NotesItem 
    Dim valueArray() As String
    Dim kom As String
    Dim kkey As String
    Dim PolicyPatch As String
    On Error Goto ErrH
    Set uiview = ws.CurrentView
    Set dc1 = uiview.Documents
    Dim values() As Variant
    Dim response As Variant
    response = ""
    
    Set db = session.CurrentDatabase
    server = db.Server
    Set view = db.GetView ("reg" )
    Set docreg = view.GetFirstDocument
    PolicyPatch = docreg.PolicyPatch(0)'путь к базе 'Структура'
    Print  "PolicyPatch "  PolicyPatch    
    
    If dc1.Count<2 Then
        Msgbox "Необходимо выбрать по крайней мере два документа !"
        Exit Sub
    End If
    
    Set curdoc = dc1.GetFirstDocument
    
    user = session.CommonUserName
    
    picklist = ws.PickListStrings( _
    PICKLIST_CUSTOM, _
    True, _
    server, _
    "promdoc\policy", _
    "StrukChoice2", _
    "Сотрудники организации", _
    "Выберите кому отправить документ", _
    2 ) 
    If picklist(0) = "" Then Messagebox("Выбор не сделан") : Exit Sub
    
    kom = Inputbox$ ( "Введите комментарий","ADMIN" )
    If kom = "" Then Exit Sub
    
    While Not (curdoc Is Nothing)
        curdoc.komment = kom    
        
        Set item = curdoc.GetFirstItem( "who" )    
        i=0
        
        Redim values(Ubound(item.Values)) As Variant
        
        If Ubound(item.Values)>0  And     response = "" Then    ' первый раз - выбрать с кого снимать из who
            Forall v In item.Values
                values(i) = v
                i=i+1
            End Forall
            response = ws.Prompt (PROMPT_OKCANCELLIST, _
            "Рассматривает несколько человек!", _
            "У кого снять с рассмотрения?", _
            values(0), values)
            Print "response" response
        End If
        
        If Ubound(item.Values)>0  Then    '  для всех где   who 2+ чела.
            curdoc.empty=""
            Set item2 = curdoc.GetFirstItem("empty")  '   удалить у выбранного, если рассмастривало несколько чел 
            Forall v In item.Values
                If v <> response Then  Call item2.AppendToTextList(v)
            End Forall
            curdoc.who=curdoc.empty
        End If
        
' добавляем всех выбранных для отправки документа сотрудников в поле who + FullTrim    
' авторами документа становятся только сотрудники, которым документ отправлен    
        Set item = curdoc.GetFirstItem( "who" )    
        picklist = Fulltrim(picklist)
        Forall v In picklist
            Call item.AppendToTextList( v )
        End Forall
        
        curdoc.addauthors = ""    
        
        i=Ubound(item.Values)     ' определяем размерность массива (сколько значений в поле who)        
        
        curdoc.empty=""
        Set item4 = curdoc.GetFirstItem("empty")  ' Удаляем дубли   из item (поле who)
        Forall v In item.Values
            If Not item4.contains(v) Then Call item4.AppendToTextList(v)
        End Forall    
        curdoc.who=curdoc.empty
        curdoc.empty = ""
        
' ответственный за документ - первый сотрудник в поле who    
        curdoc.main_isp = curdoc.who(0)
        
' добавляем сотрудника, который документ отправляет в читатели документа    
        Set item2 = curdoc.GetFirstItem("addreaders")
        Call item2.AppendToTextList(user)    
        
        
        mes3=""
        Forall v In picklist  ' фомируем mes3 для добавления в историю
            mes3=mes3+v+"; "
        End Forall
        sdate = Evaluate("@Now( [SERVERTIME])")
            '  ----------- ИСТОРИЯ
        mes2=sdate(0) +"   документ отправил "&Chr(13)+user+" на " + mes3+" "&Chr(13)+" с комментарием: " + kom &Chr(13)+" "&Chr(13)
        curdoc.shadowhistory = mes2 + curdoc.shadowhistory(0)
        curdoc.history=mes2 + curdoc.history(0)
        
        
            ' Основной Исполнитель - первый сотрудник в поле who    
    ' находим ответственного за документ сотрудника в БД "Структура" -----------------------------------
        Set strukdb = session.GetDatabase(server, PolicyPatch , False )
        Set view = strukdb.GetView("notespeople")
        Set strukdc = View.GetAllDocumentsByKey(curdoc.main_isp, True )
        
        If strukdc.count=0 And curdoc.main_isp(0)<>"" Then     Msgbox ("Основной Исполнитель не найден в Структуре организации!!!")
        If strukdc.count > 1 Then Msgbox ("Внимание! в структуре организации обнаружены идентичные элементы !")
        If strukdc.count > 0 Then     
            Set strukdoc = strukdc.GetFirstDocument() '  первый исполнитель из поля main_isp
            curdoc.hierarchy = strukdoc.subdivision(0) ' для отображения документа в представлении "по подразделениям"     
            Set item3 = curdoc.GetFirstItem( "addauthors" )        ' добавление руководителя подразделения из структуры  в поле addauthors    
            If strukdoc.shef(0) <>"" Then Call item3.AppendToTextList(strukdoc.shef(0))
        End If
        
    ' в соответствии с нотес именем в поле who заносим в поле whois должности и ФИО -------------------------
        curdoc.whois=""
        Set item5 = curdoc.GetFirstItem("whois")
        Forall v In item.Values   ' поле who
            Set ftdoc=view.GetDocumentByKey(v)  ' вид notespeople БД Структуры
            If (ftdoc Is Nothing) Then    
                Msgbox ("Исполнитель: ") + v  +  (" не найден в Структуре организации.")
            Else
                Call item4.AppendToTextList(v)     ' ФИО есть в структуре, добавить в empty (потом в who)
                Call item5.AppendToTextList(ftdoc.position(0)+" "+ftdoc.fio(0)) ' ФИО и Должность добавить в  whois        
            End If        
        End Forall    
        
        curdoc.who=curdoc.empty
        curdoc.empty = ""
    '  ---------------------------------    
        
        curdoc.lastsenddate=sdate(0)  ' дата последней отправки документа
        curdoc.main_isp = curdoc.who(0)    'ответственный за документ     ФИО
        curdoc.main_isp2 = curdoc.whois(0)    ' ответственный за документ     должность + ФИО
        
        curdoc.addreaders=Arrayunique(curdoc.addreaders)  ' 2020 Боря
        Call curdoc.Save(True, False)
        
' находим все дочерние документы    и приравниваем значение полей who, addreaders, addauthors (у кого документ находится)
        Set dc = curdoc.Responses
        Set ftdoc = dc.GetFirstDocument    
        While Not ftdoc Is Nothing
            If ftdoc.IsValid=False Then 
                Print "Документ не валидный"
            Else
                ftdoc.who = curdoc.who
                ftdoc.addreaders = curdoc.addreaders
                ftdoc.addauthors = curdoc.addauthors
                ftdoc.hierarchy = curdoc.hierarchy
                ftdoc.history=mes2+ftdoc.history(0)
                ftdoc.save True, False
            End If
            Set ftdoc = dc.GetNextDocument (ftdoc )
        Wend    
        
        
        Set curdoc = dc1.GetNextDocument (curdoc)
    Wend
    Call uiview.DeselectAll
'    Call uiview.View.Refresh()
'    Call view.Refresh
    Msgbox "ОК!"
    Exit Sub
ErrH:    
    Print  Error & | in line | & Erl(),
    Exit Sub
End Sub