Тема: Агент переноса документов в архивную БД
Агент для переноса документов из рабочей базы (например, документооборот) в архивную БД.
логика:
1. сначала проверяем, есть ли уже документ в архиве, если нету - создаем в архиве.
2. сверяем, есть ли в архиве документ такой же, как в рабочей базе (отослали в архив). Если есть - стираем в рабочей.
Dim session As New NotesSession
'Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase, arcdb As NotesDatabase
Dim view As NotesView, arcview As NotesView
Dim doc As NotesDocument, prevdoc As NotesDocument, nextdoc As NotesDocument, newdoc As NotesDocument, arcdoc As NotesDocument
Dim server As String
Dim askme As Variant
Set db = session.CurrentDatabase
server = db.Server
Set view=db.GetView("buf") ' доки на архивирование
Set arcdb = New NotesDatabase( server, "arc.nsf" )
Set arcview = arcdb.GetView("arc_check") ' вид проверки в архивной базе
Call arcdb.UpdateFTIndex( False )
Set doc = view.GetFirstDocument ' док в основной базе, который пошлется в архив
While Not (doc Is Nothing)
Set arcdoc = arcview.GetDocumentByKey( doc.id(0)) 'есть ли уже док на архивирование в архиве
If arcdoc Is Nothing Then ' если дока нет в архиве
Set newdoc=arcdb.CreateDocument 'создали в архиве
Call doc.CopyAllItems(newdoc,1)
newdoc.UniversalID=doc.UniversalID
Call newdoc.Save(True,False)
' doc.who="извлечен"
Call doc.Save(True,False)
End If
Set nextdoc = view.getnextdocument(doc)
Set doc=nextdoc
Set nextdoc=Nothing
Wend
'---------------------------------------------------------------------------------------------------------
Call arcdb.UpdateFTIndex( False )
Call arcview.Refresh()
Set doc = view.GetFirstDocument 'архивируемые доки с основной базы ищем в архиве
While Not (doc Is Nothing)
Set arcdoc = arcview.GetDocumentByKey( doc.id(0))
If arcdoc Is Nothing Then ' если такого документа нет в архиве
'askme=ws.prompt(prompt_okcanceledit, "Внимание!", "Документ с текущим UNID не перенесен в архив", Cstr(doc.id(0)))
Print "документ не перенесен в архив"
Exit Sub
End If
' если есть в архиве - удаляем его из основной базы
Call doc.Remove(False)
Set doc = view.GetFirstDocument
Wend
'Call ws.ViewRefresh