Перенос документов между базами.

Sub Click(Source As Button)
    Dim session As New NotesSession
    Dim ws As New NotesUIWorkspace
    Dim db As NotesDatabase
    Dim db2 As NotesDatabase
    Dim view As NotesView, view2 As notesview
    Dim dc As NotesDocumentCollection
    Dim curdoc As NotesDocument, doc As NotesDocument, ftdoc As NotesDocument, newdoc As NotesDocument
    Dim nextdoc As NotesDocument
    Dim item As NotesItem, item2 As NotesItem, item3 As NotesItem
    Dim server As String, formula As String, str1 As String
    Dim i As Variant
    i=0
    
    On Error Goto ErrH
    server=session.CurrentDatabase.Server
    Set db2=session.GetDatabase(server,"promdoc\documentsПриемник.nsf")
    Set db=session.GetDatabase(server,"promdoc\documentsИсточник.nsf")  ' 
    Set curdoc=ws.CurrentDocument.Document
    Set view=db.GetView("admin_allwork")
    Set doc=view.GetFirstDocument
    While Not doc Is Nothing
    '    Set item2=doc.GetFirstItem("empty")
    '    doc.empty=""
        Print doc.header(0)
    '    Set item=doc.GetFirstItem("who")  ' замена поля Расматривает
    '    Forall v In item.Values
    '        v = "CN=" + v + "/O=inf"
    '        Print v 
    '        Call item2.AppendToTextList(v)
    '    End Forall
    '    doc.who=doc.empty
    '    item.IsAuthors= True
    '    doc.empty=""
        
    '    Set item=doc.GetFirstItem("addauthors")  ' замена поля addauthors
    '    Forall v In item.Values
    '        v = "CN=" + v + "/O=inf"
    '        Call item2.AppendToTextList(v)
    '    End Forall
    '    doc.addauthors=doc.empty
    '    item.IsAuthors= True
    '    doc.empty=""
        
    '    Set item=doc.GetFirstItem("addreaders")  ' замена поля addreaders
    '    Forall v In item.Values
    '        v = "CN=" + v + "/O=inf"
    '        Call item2.AppendToTextList(v)
    '    End Forall
    '    doc.addreaders=doc.empty
    '    item.IsReaders= True
    '    doc.empty=""
        
'---------------обработка ответных документов    
'        Set dc=doc.Responses
'        Set ftdoc=dc.GetFirstDocument
'        While Not ftdoc Is Nothing
    '        ftdoc.who = doc.who 
    '        ftdoc.addauthors=doc.addauthors
    '        ftdoc.addreaders=doc.addreaders
    '        Call ftdoc.ComputeWithForm(0,0)
    '        Call ftdoc.Save(True, False)
        
'            Print "Создаем Ответный док в Цифре"
'            Set newdoc=db2.CreateDocument        
'            Call ftdoc.CopyAllItems(newdoc,1)
'            newdoc.UniversalID=ftdoc.UniversalID
'            newdoc.smi = "1"
'            Call newdoc.ComputeWithForm(0,0)
'            Call newdoc.Save(True,False)
'            Print "Создали Ответ"
        
'            Set ftdoc=dc.GetNextDocument(ftdoc)
'        Wend
        
        Print "Создаем Главный док в Цифре"
    '    Call doc.Save(True, False)
        Set newdoc=db2.CreateDocument    
        Call doc.CopyAllItems(newdoc,1)
        newdoc.UniversalID=doc.UniversalID
        newdoc.smi = "1"
        Call newdoc.ComputeWithForm(0,0)
        Call newdoc.Save(True,False)
        Print "Создали Главный"
        
        Set nextdoc = view.getnextdocument(doc)
        Set doc=nextdoc
        Set nextdoc=Nothing
        i=i+1
        Print Cstr(i)
        'If i = 1 Then Exit Sub
    Wend
    Msgbox "Замена  прошла успешно"
    Exit Sub
ErrH:
    Msgbox "Ошибка  " & Error(Err) & " в строке " & Erl    
    Exit Sub
End Sub