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

Sub Click(Source As Button)
    On Error Goto ErrH
    Dim session As New NotesSession
    Dim ws As New NotesUIWorkspace
    Dim db As NotesDatabase, strukdb As notesdatabase
    Dim uiview As NotesUIView
    Dim uidoc As NotesUIDocument    
    Dim countdoc As NotesDocument, ftdoc As NotesDocument
    Dim doc As NotesDocument, maindoc As NotesDocument
    Dim mes As String, mes2 As String, user As String, mes3 As String, server As String
    Dim resp As Variant
    Dim values(2) As Variant
    Dim i As Integer
    Dim sdate As Variant, picklist As Variant
    Dim st As String
    Dim valueArray() As String
    Dim uiftdoc As NotesUIDocument
    Dim ftuidoc As NotesUIDocument
    
    Dim item As NotesItem, item2 As NotesItem, item3 As NotesItem, item4 As NotesItem, item5 As NotesItem 
    Dim ritem As NotesItem
    
    myname$="Марина "
    
    user = session.CommonUserName
    Print user
    Set db = session.CurrentDatabase
    server = db.Server
    Set uiview = ws.CurrentView
    
    Set dc=uiview.Documents  '  все помеченные доки - будущие ответы
    If dc.count = 0 Then
        Messagebox "Необходимо пометить галочкой  документы!"
        Continue=False        
        Exit Sub
    Else
        Print "dc.count" dc.count
    End If
    
    For i=1 To dc.count ' Комментарий
        Set doc = dc.GetNthDocument (i)
        Print doc.header(0)
        doc.komment="Подписано."
        
        Set item = doc.GetFirstItem( "who" )        ' ФИО начальника
        Call item.AppendToTextList(myname$)
        doc.addauthors = ""
        
' определяем размерность массива (сколько значений в поле who) после добавления в него пользователей из списка отправки            
        i=0
        Forall v In item.Values
            i=i+1
        End Forall
        ' создается массив со значениями из поля Who, из которого убирается текущий пользователь и значение "На регистрации"    
' если отправляющего сотрудника нет в поле who (в случаес с сотрудниками наделенными соответствующими правами), он из поля  не убирается
        Redim valueArray(i) As String
        i=0    
        Forall v In item.Values
            Print "v=" v
            If v<> user And v<>"На регистрации" Then 
                valueArray(i)= v 
                i=i+1
                Print Cstr(i) "." v 
            End If
        End Forall        
        ' замещаем who на массив    
        Item.Values =  Fulltrim(valueArray)
        
        Set item4 = doc.GetFirstItem("empty")  ' в empty все уникальные значения who без дублей
        Forall v In item.Values
            If Not item4.contains(v) Then Call item4.AppendToTextList(v)
        End Forall    
        doc.who=doc.empty
        doc.empty = ""
        
' добавляем Гу////   в читатели документа    
        Set item2 = doc.GetFirstItem("addreaders")
        Call item2.AppendToTextList(user)    
        Call item2.AppendToTextList(myname$)
        
        Set item2 = doc.GetFirstItem("whois")
        Call item2.AppendToTextList("Начальника управления Марина ")        
        
        ' история
        sdate = Evaluate("@Now( [ServerTime])")
        mes3 = "Марина Владимировна"
        mes=doc.history(0)
        mes2=sdate(0)+"   документ отправил "&Chr(13)+user+" на " + mes3+" "&Chr(13)+" с комментарием: " + doc.komment(0)&Chr(13)+" "&Chr(13)
        doc.history=mes2+mes
        
        ' ответственный за документ (по username)- первый сотрудник в поле who    
        doc.main_isp = doc.who(0)    
        doc.hierarchy = "Управление делами"
        
        '  ----------------------------------------------------счетчик отпраленных на сотрудника документов
        ' находим ответственного за документ сотрудника в БД "Структура"
        Set strukdb = session.GetDatabase(server, "//....PDoc\poly.nsf" , False )
        Set view = strukdb.GetView("notespeople")
        Set ftdoc=view.GetDocumentByKey(myname$)
        
        ' в соответствии с нотес именем в поле who заносим в поле whois должности и ФИО
        Set item = doc.GetFirstItem("who")
        doc.whois=""
        Set item5 = doc.GetFirstItem("whois")
        Forall v In item.Values
            Set ftdoc=view.GetDocumentByKey(v)
            str1 = ftdoc.position(0)+" "+ftdoc.fio(0)
            Call item5.AppendToTextList(str1)        
        '  ----------счетчик отпраленных на сотрудника документов
            Set countdoc    = strukdb.CreateDocument
            countdoc.form="counter"
            Call countdoc.MakeResponse(ftdoc)
            countdoc.id=doc.id(0)
            countdoc.datesend=sdate(0)
            countdoc.typedoc=doc.form(0)
            countdoc.parentfio=myname$
            countdoc.computewithform False, False
            Call countdoc.Save(True,True)    
        End Forall    
        
        doc.lastsenddate=sdate(0)    ' дата последней отправки документа
        doc.main_isp2 = doc.whois(0)        ' ответственный за документ    
        
' находим все дочерние документы. who, addreaders, addauthors с главного
        Set dc = doc.Responses    
        Set ftdoc = dc.GetFirstDocument    
        While Not ftdoc Is Nothing
            If ftdoc.IsValid=False Then 
                Print "Документ не валидный"
            Else
' передается фокус ui на документ - ответ, для их последующего закрытия.        
                Set ftuidoc = ws.EditDocument( False, ftdoc , True ,  , True, False )
                ftdoc.who =doc.who
                ftdoc.whois=doc.whois
                ftdoc.addreaders =doc.addreaders
                ftdoc.addauthors =doc.addauthors
                ftdoc.history=mes2+ftdoc.history(0)
                ftdoc.save True, False
                
                If ftdoc.responce(0)="1"  Then Call ftuidoc.Close(True)
        'Call ftuidoc.Close(True)
            End If
            Set nextftdoc = dc.GetNextDocument (ftdoc )
            Set ftdoc=nextftdoc
            Set nextftdoc=Nothing
            
        Wend    
        
        
        Call        doc.save (True,Fase)
    Next    
    
    uiview.DeselectAll
    Msgbox "Документы успешно отосланы на Марину."
    Call ws.ViewRefresh
    Exit Sub
ErrH:
    Print "Ошибка: " & Error(Err) & " в строке " & Erl
End Sub