Function GetUnidFromUrl(url$)
    ' получить Unid док-та по урлу
    GetUnidFromUrl=Mid(url,Instr(url,"?")-32,32)
End Function

Sub Initialize
    Dim ns As NotesSession   
    Dim db As NotesDatabase   
    Dim doc1 As NotesDocument
    Dim curdoc As NotesDocument   
    Dim item As NotesItem
    Dim agent As NotesAgent   
    Dim url_link_doc As String
    Dim url_cur_doc As String
    Set ns = New NotesSession   
    Set db = ns.CurrentDatabase   
    Set agent = ns.CurrentAgent   
   
    'Получаем параметр, передаваемый в агент, то есть получаем Noteid
    NoteId = agent.ParameterDocID   
     'Получаем документ   
    Set doc1 = db.GetDocumentById(NoteId)   
     'Получаем url linkdoc-a    
    Set item = doc1.GetFirstItem("Field_linkdoc_url")
    If (item Is Nothing) Then
        Print "Field_linkdoc_url не найдено!"
    Else
        url_link_doc=item.Text
    End If
    'Получаем url curdoc-a    
    Set item= doc1.GetFirstItem ("Field_curdoc_url")
    If (item Is Nothing) Then
        Print "Field_curdoc_url не найдено!"
    Else
        url_cur_doc=item.Text
    End If
    '--------------------сохранение связи в связуемом документе----------------------------------------
    Dim ldb As New notesdatabase("","")
    Dim linkdoc As  NotesDocument
    'If ns.CurrentDatabase.ReplicaID<>GetReplFromUrl(url) Then
    '    Call ldb.OpenByReplicaID(ns.CurrentDatabase.Server,GetReplFromUrl(url))
    'Else       
    Set ldb=ns.CurrentDatabase
    'End If
   
    Set linkdoc=ldb.GetDocumentByUNID(GetUnidFromUrl(url_link_doc))
    Print"url " + Cstr(url_link_doc)
    Call linkdoc.ReplaceItemValue("Linked_From",Fulltrim(Arrayunique(Arrayappend(linkdoc.Linked_From,url_cur_doc))))
   
    On Error Goto err1
   
    Call linkdoc.Save(1,0)
   
    Set curdoc=db.GetDocumentByUNID(GetUnidFromUrl(url_cur_doc))
    Call curdoc.ReplaceItemValue("Linked_To",Fulltrim(Arrayunique(Arrayappend(curdoc.Linked_To,url_link_doc))))
    Call curdoc.Save(1,0)
   
    'Удаляем док-запрос
    Call doc1.Remove(True)
   
    Print "СВЯЗЬ УСТАНОВЛЕНА!"
    Exit Sub
err1:       
    Messagebox "Связь не установлена! Проблемма безопасности!",0+48,"Связи!"
    Exit Sub
End Sub

Sub Click(Source As Button)
    On Error Goto Errh
   
    Dim ns As New NotesSession   
    Dim db As NotesDatabase   
    Dim agent As NotesAgent   
    Dim docRequest As NotesDocument  'Новый документ запрос
    Dim linkdoc As NotesDocument  'Док из которого копируем связь
    Dim curdoc As NotesDocument 'Текущий(куда копируем связь)док
    Dim Unid As String
    Dim Unid1 As String
    Dim uilinkdoc As NotesUIDocument
    Dim uicurdoc As NotesUIDocument   
    Dim paramid As String
    Dim nw As New NotesUIworkspace
   
    Set uicurdoc=nw.CurrentDocument
    Set curdoc=uicurdoc.Document
   
    If uicurdoc.EditMode    Then
        uicurdoc.Save
    End If
   
    Set db = ns.CurrentDatabase   
    'Set curdoc=nw.CurrentDocument.Document
   
    'Читаем переменную окружения и выделяем из нее Url(link_doc) 
    Dim url As String
    url=ns.GetEnvironmentString("_url")
    Unid=GetUnidFromUrl(url)
    Unid1=GetUnidFromUrl(curdoc.NotesURL)
   
    'Создаем новый док(док-запрос) и записываем в него url дока(linkdoca) из которого копируем связь и url дока(текущего) куда вставляем связь
    Set docRequest = db.CreateDocument    
    Set item = docRequest.AppendItemValue("Field_linkdoc_url", url)
    Set item = docRequest.AppendItemValue("Field_curdoc_url", curdoc.NotesURL)
    Call docRequest.save(True, False)
   
    'Получаем агента(серверного с правами менеджера), передаем ему параметр(Noteid дока-запроса,и запускаем агент)
    Set agent = db.GetAgent("Links_Paste")
    paramid = docRequest.Noteid
    Call Agent.RunOnServer(paramid)
   
    ''
    REM Необходимо обновить два дока:
     REM Закрываем текущий, получаем предыдущий, закрываем предыдущий, открываем предыдущий на просмотр
     REM получаем текущий и окрываем на просмотр
    'В переменную paramid записываем параметр Noteid текущего документа, стираем его из памяти и закрываем
    'paramid = curdoc.Noteid
    paramid = curdoc.UniversalID
    Delete curdoc
    Call uicurdoc.Close(True)
    '''Call nw.CurrentDocument.Close(True)   
    ''
    'Получаем linkdoc, проверяем если он открыт в UI устанавливаем его текущим и закрываем
    Set linkdoc = db.GetDocumentByUNID (Unid)
    If linkdoc.IsUIDocOpen Then
        Call nw.SetTargetFrame("")
        Set uilinkdoc = nw.EditDocument(False, linkdoc, False,,False,False)
        Delete linkdoc
        Call uilinkdoc.Close(True)
        'Delete linkdoc
    'End If
    'Проверяем если linkdoc открыт в UI, стираем его из памяти, получаем его, окрываем на просмотр
    'If linkdoc.IsUIDocOpen Then   
        'Delete linkdoc
        Set linkdoc = db.GetDocumentByUNID (Unid)
        Set uilinkdoc = nw.EditDocument(False, linkdoc)
    End If
    'Получаем Текущий док и открывает его на просмотр
    'Set curdoc = db.GetDocumentById(paramid)
    Set curdoc = db.GetDocumentByUNID(paramid)
    Set uicurdoc = nw.EditDocument(False, curdoc)
     ''
    Exit Sub
errh:
    Msgbox Error & | in line | & Erl(), 64, |Lotus Notes (| & Lsi_info(2) & |)|
    Exit Sub
End Sub

Копировать связь:

Sub Click(Source As Button)
    Dim nw As New NotesUIworkspace
    Dim ns As New NotesSession
    Dim nd As NotesDocument
    Dim uind As NotesUIDocument
    Set nd=nw.CurrentDocument.Document
    Set uind=nw.CurrentDocument
    '
    If uind.IsNewDoc Then
       
        flag=Messagebox ("Документ, с которого выкопируете связь не сохранен!Сохранить документ?"+Chr(13) +"При нажатии на кнопку  Отмена связь не будет скопирована!!!",1+64+0+0, "Сообщение...")
        Const IDCancel=2
        If flag=IDCancel Then
            Exit Sub   
        Else
            'Call nd.Save(True,False)
            Call uind.Save
        End If
    End If
'
    Call ns.SetEnvironmentVar("_url",nd.NotesURL)
    Print "СВЯЗЬ СКОПИРОВАНА!"
End Sub