Тема: Удаление поля $ref у ответного документа. Сделать документ главным.
Вариант просто удалить $ref у ответного документа - не работает.
Код кнопки Сделать документ главным.
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
flag=Messagebox ("Сделать документ главным?После переоткрытия документ станет главным"+Chr(13) +"При нажатии на кнопку Отмена документ останется ответным!!!",1+64+0+0, "Сообщение...")
Const IDCancel=2
If flag=IDCancel Then
Exit Sub
Else
Set db=ns.CurrentDatabase
Set uicurdoc=nw.CurrentDocument
Set curdoc=uicurdoc.Document
'Создаем новый док(док-запрос) и записываем в него url дока(linkdoca) из которого копируем связь и url дока(текущего) куда вставляем связь
Set docRequest = db.CreateDocument
'
Set item = docRequest.AppendItemValue("Field_curdoc_url", curdoc.NotesURL)
Set item =docRequest.AppendItemValue("Field_user_name", ns.UserName)
Call docRequest.save(True, False)
'Получаем агента(серверного с правами менеджера), передаем ему параметр(Noteid дока-запроса,и запускаем агент)
Set agent = db.GetAgent("DelRefto")
paramid = docRequest.Noteid
Call Agent.RunOnServer(paramid)
''
Call uicurdoc.Close()
Set myview = db.GetView("my")
Call myview.Refresh
Set myview = db.GetView("myembed")
Call myview.Refresh
End If
Exit Sub
errh:
Msgbox Error & | in line | & Erl(), 64, |Lotus Notes (| & Lsi_info(2) & |)|
Exit Sub
End Sub
Агент DelRefto
Sub Initialize
Dim ns As NotesSession
Dim db As NotesDatabase
Dim docrequest As NotesDocument '--документ-запрос
Dim curdoc As NotesDocument
Dim sdoc As NotesDocument '-- документ в базе links
Dim item As NotesItem
Dim agent As NotesAgent
Dim url_link_doc As String '-- URL документа откуда копируем связь
Dim url_cur_doc As String '-- URL документа куда втавляем связь
Dim user_name As String '-- Имя пользователя кто копирует/вставляет связь
Dim id_link As String '--Переменная для Unid link документа
Dim id_curdoc As String '--Переменная для Unid текущего документа
Dim session As New NotesSession
Set ns = New NotesSession
Set db = ns.CurrentDatabase
Set agent = ns.CurrentAgent
Dim Noteid As Variant
On Error Goto Errh
'Получаем параметр, передаваемый в агент, то есть получаем Noteid
NoteId = agent.ParameterDocID
'Получаем документ
Set docrequest = db.GetDocumentById(NoteId)
'Получаем url curdoc-a
Set item= docrequest.GetFirstItem ("Field_curdoc_url")
If (item Is Nothing) Then
Print "Field_curdoc_url не найдено!"
Else
url_cur_doc=item.Text
End If
'Получаем user_name
Set item= docrequest.GetFirstItem ("Field_user_name")
If (item Is Nothing) Then
Print "Field_user_name не найдено!"
Else
user_name=item.Text
End If
'---
id_curdoc=GetUnidFromUrl(url_cur_doc) '--Получаем Unid текущего документа
Set sdoc=DatabaseGetDocumentByUnid(db,id_curdoc) '--Получаем curdoc-документ в базе
If sdoc Is Nothing Then
'
Goto Errh
Else
Dim tt As NotesItem
'Set tt=sdoc.Getfirstitem("$Ref")
'Call item.Remove()
sdoc.responce=""
sdoc.parent=""
sdoc.parent2=""
sdoc.isreg=""
Call sdoc.Removeitem("$Ref")
Call sdoc.Save(1,0)
End If
'Удаляем док-запрос
Call docrequest.Remove(True)
Exit Sub
Errh:
'Создание документа в БД связей, с номером ошибки , также Print ошибки в базе Log на сервере
'Call CreateDocError(Cstr(Error) & " in line " & Cstr(Erl()) & " Lotus Notes (" &Cstr(Lsi_info(12)) & ")", url_cur_doc )
Print Error & | in line | & Erl(), 64, |Lotus Notes (| & Lsi_info(2) & |)|
Exit Sub
End Sub