Тема: Удаление старых документов с базы.
Агент удаляет документы и вложения, в зависимости от времени в днях в служебных полях Del_XML_Time и Del_Lotus_Time.
Option Public
Use "Lib_Other"
Sub Initialize
On Error GoTo ErrH
Dim session As New NotesSession, db As NotesDatabase
Dim doc As NotesDocument' доки в роутере
Dim item As NotesItem, object As NotesEmbeddedObject, rtitem As NotesRichTextItem
Dim dateTime As New NotesDateTime( "" ), DocColl As NotesDocumentCollection
Dim vFile As NotesEmbeddedObject
Dim i As Integer
Print "KillOldXML старовал агент!"
Call dateTime.SetNow
Set db = session.CurrentDatabase ' роутер
Set view_conf=db.GetView("Config")
Set doc_conf=view_conf.GetFirstDocument
If doc_conf.Del_XML_Time(0) = "" Then Print("Поле Del_XML_Time в конфиге пустое!") : Exit Sub
If doc_conf.Del_Lotus_Time(0) = "" Then Print("Поле Del_Lotus_Time в конфиге пустое!") : Exit Sub
Del_XML_Time% = CInt (doc_conf.Del_XML_Time(0)) * (-1)
Del_Lotus_Time% = CInt (doc_conf.Del_Lotus_Time(0))* (-1)
Dim weekDateTime As NotesDateTime
Set weekDateTime = New NotesDateTime( "Today" )
Call weekDateTime.AdjustDay( Del_XML_Time% )
Print "weekDateTime.DateOnly " CStr(weekDateTime.DateOnly)
searchFormula$ = {Form = "fmejved" & kill !="1" & @Created < @date([} & CStr(weekDateTime.DateOnly) & {])}
Print "searchFormula " searchFormula$
Dim collection As NotesDocumentCollection
'Call dateTime.SetNow
'Call dateTime.AdjustMonth(-1)
Set DocColl = db.Search(searchFormula$,Nothing,0) 'dateTime
Print "DocColl.Count:" DocColl.Count
If DocColl.Count=0 Then
Print "1.агент KillOldXML нет XML документов."
Else
For i=1 To DocColl.count
Set doc = DocColl.GetNthDocument(i)
Print CStr(doc.Created) " - " CStr(doc.ЗАГОЛОВОК(0))
Set rtitem = doc.GetFirstItem( "ПРИЛОЖЕНИЯ_" )
Print "ПРИЛОЖЕНИЯ_"
If Not IsEmpty( rtitem.EmbeddedObjects) Then
Set vFile = rtitem.GetEmbeddedObject(rtitem.EmbeddedObjects(0).Source)
If Not ( vFile Is Nothing ) Then
If ( vFile.Type = EMBED_ATTACHMENT ) Then
Print "EMBED_ATTACHMENT"
Else
Print "EMBED_NO"
End If
Call vFile.Remove 'удаляем аттачмент с лотус дока
Call rtitem.Update
doc.kill="1"
Call doc.Save(True, False)
Print doc.ЗАГОЛОВОК(0) " удалили вложение"
End If
End If
Next
End If
Print "2. Удаление старых карточек"
Call weekDateTime.AdjustDay( Del_Lotus_Time% )
searchFormula$ = {Form = "fmejved" & @Created < @date([} & CStr(weekDateTime.DateOnly) & {])}
Print "searchFormula " searchFormula$
Set DocColl = db.Search(searchFormula$,Nothing,0)
If DocColl.Count=0 Then
Print "2.агент KillOldXML нет старых лотус карточек."
Else
Print "DocColl.Count на удаление старых карточек:" DocColl.Count
For i=1 To DocColl.count
Set doc = DocColl.GetNthDocument(i)
Print CStr(doc.Created)
doc.Remove(1)
Next
End If
Print "KillOldXML - Отработал!"
Exit Sub
%REM Вадим - примерно так хотел? нет.. я так не хотел...
Dim view As NotesView
formula="SELECT (Form = "fmejved") & @Created < @date("+ CStr(weekDateTime.DateOnly) + ")"
Set view= db.CreateView("tmp",formula)
view.Autoupdate = false
Set doc=view.GetFirstDocument
While Not doc Is Nothing
doc.Remove(1)
Set doc = view.GetNextDocument( doc )
Wend
%End rem
ErrH:
Print "ошибка - KillOldXML Agent"
'Запись об ошибке в лог
Print "Агент KillOldXML - Ошибка: " & Error(Err) & " в строке " & Erl
infa$=CStr(Now) & " Агент "& agent.Name &" (ф-ция Initialize): " & "Ошибка " & Error$ & " в строке " & Erl()
If Not(doc Is Nothing) Then infa$=infa$ & " UNID doc: " & doc.Universalid
If Not(docD Is Nothing) Then infa$=infa$ & " UNID docD: " & docD.Universalid
Call AppendsInLogs(db, infa$)
Print "лог сохранен"
Exit Sub
End Sub