Серверный агент для переноса документов в другую базу

Option Public
Option Declare

Sub Initialize
    Dim session As New NotesSession
    Dim db As NotesDatabase
    Dim respview As NotesView, uniview As NotesView
    Dim curdoc As NotesDocument, maindoc As NotesDocument, docreg As NotesDocument
    Dim  nextdoc As NotesDocument
    Dim docR As NotesDocument
    Dim RTItm As NotesRichTextItem, view As NotesView, db2 As NotesDatabase'Межмин    
    Dim server As String, databaseFileName As String
    Dim item As NotesItem
    Print "START Megved" 
    On Error GoTo Errh
    Set db=session.Currentdatabase
    
    Set view = db.GetView ("reg" )
    
    Set docreg = view.GetFirstDocument
    If docreg Is Nothing Then Print("Нет доступа к настройкам регистрации!") : Exit Sub    
    server = docreg.Router(0)   
    databaseFileName =   docreg.RouterFile(0)
    Set db2 = Session.GetDatabase(server$, databaseFileName$)
    If Not db2.Isopen Then'проверка доступа к базе Межмин'
        Print "Нет доступа к Базе Роутер!"
        Exit Sub
    End If
    
    Dim PolicyPatch As String
    Dim server_docs As String
    Dim view_policy As NotesView
    PolicyPatch = docreg.PolicyPatch(0)
    server_docs = docreg.AdresatS(0)
    Dim db_policy As NotesDatabase
    Set db_policy = session.GetDatabase(server_docs, PolicyPatch)
    If Not db_policy.Isopen Then'проверка доступа к базе Межмин'
        Print "Нет доступа к Базе Структура!"
        Exit Sub
    End If
    
    Set view_policy =db_policy.GetView("counteropen") ' Бд структура - открытый док
    Call view_policy.Refresh()
    Call view_policy.Refresh()
    Dim viewCol As NotesViewEntryCollection
    Set viewCol = view_policy.Allentries
    Print "view_policy " CStr(viewCol.Count)
    Dim entry As NotesViewEntry
    Set entry    = viewCol.GetFirstEntry
    Do While Not (entry Is Nothing)
        Print "Universalid:" entry.Columnvalues(0)
        Set entry = viewCol.GetNextEntry( entry )    
    Loop
    
    
    Dim doc_policy As NotesDocument

    Set uniview = db.getview("Mejved-out-agent")
    uniview.AutoUpdate =False
    Set curdoc = uniview.getfirstdocument

    While Not curdoc Is Nothing
        Print "curdoc.id(0) " curdoc.id(0)
        Set doc_policy=view_policy.GetDocumentByKey(curdoc.id(0))

        If (doc_policy Is Nothing) Then 
            Print  "нет UNID в структуре в counteropen (док НЕ открыт юзером)"
            Set docR = New NotesDocument( db2 ) ' создали новый док в базе роутер

            ' копируем нужные поля            
            Set item = CurDoc.GetFirstItem( "header" )
            Call docR.CopyItem (item,"ЗАГОЛОВОК")
            
            Set item = CurDoc.GetFirstItem( "adresed" )
            Call docR.CopyItem (item,"АДРЕСАТ")
            
            Set item = CurDoc.GetFirstItem( "regnom_1" )
            Call docR.CopyItem (item,"РЕГИСТРАЦИОННЫЙ_НОМЕР")
            
            Set item = CurDoc.GetFirstItem( "datereg" )
            Call docR.CopyItem (item,"ДАТА_РЕГИСТРАЦИИ")
            
            Set item = CurDoc.GetFirstItem( "NameOrg" )  'НЕИСП в XML, 
            Call docR.CopyItem (item,"NameOrg")
            
            Set item = CurDoc.GetFirstItem( "isp" )
            Call docR.CopyItem (item,"ФАМИЛИЯ")
            
            Set item = CurDoc.GetFirstItem( "Server_id" )
            Call docR.CopyItem (item,"Server_id")
            
            docR.id_doc =  CurDoc.id(0)
            
            If CurDoc.hasitem("count_adressed") Then docR.count_adressed=CurDoc.count_adressed    
            
            Set item = CurDoc.GetFirstItem( "XMLattach" )
            If Not item Is  Nothing     Then Call docR.CopyItem (item,"ПРИЛОЖЕНИЯ_")
            
            Set item = CurDoc.GetFirstItem( "IDXml" )
            Call docR.CopyItem (item,"IDXml")
            
            ' ----------------            
            docR.Form="fmejved"
            docR.fxml="0"
            docR.ТИП_ДОКУМЕНТА="Исходящий"
            
            Call docR.Save(True, True)
            CurDoc.Server_id="отправлено"
            CurDoc.flagXML="3"
            Dim Adresat As string, Adr As Variant
            Adresat=""
            Adr = CurDoc.GetItemValue( "NameOrg" )
            ForAll tmp In Adr ' все адресаты в строку
                Adresat = Adresat  +" " + tmp
            End ForAll    
            
CurDoc.history="МЭД: в " + CStr(Now) + " документ " + CurDoc.IDXml(0) + " отправил " + session.CommonUserName + " "&Chr(13)+" на "+ Adresat  +"." &Chr(13)+" "&Chr(13) + CurDoc.history(0)
            
            Call CurDoc.Save(True,False)    
            
            'Set curdoc = uniview.GetNextDocument (curdoc )    
        Else
            Print  "Док открыт у " doc_policy.fio(0)
        End If    
        
        Set nextdoc = uniview.getnextdocument(CurDoc)
        Set CurDoc=nextdoc
        Set nextdoc=Nothing
    Wend

    Exit Sub
Errh:    
    Print Error & | in line | & Erl()
    Exit Sub
End Sub