Hallo zusammen,
für die Protokkolierung der Löschdokumente habe ich mit foldem Code versucht, klappt es irgent wie nicht. Auch keine Fehlermeldungen, der Agen läuft durch aber ohne Ergebnis.
Was mache ich hier falsch? Kann jemad hier näher diesen Code reinschauen?
Grüß
Nyen
Step 1 : create your new database. For the exemple, I'll name it «FastDeletion». I'll make also a view named «Deleted Documents» categorized on the new field name «FromDatabase».
Step 2 : modify the «QueryDocumentDelete» event
Sub Querydocumentdelete(Source As Notesuidatabase, Continue As Variant)
Dim Collection As NotesDocumentCollection
Dim Document As NotesDocument
Dim DeletedDoc As NotesDocument
'retreiving all documents that the current NotesUIDatabase event is working on
Set Collection = Source.Documents
Set Document = Collection.GetFirstDocument
Dim DBDeletion As New NotesDatabase ("", "FastDeletion.nsf")
Dim DateTime As New NotesDateTime (Today)
Dim Item As NotesItem
Do While Not (Document Is Nothing)
Set DeletedDoc = Document.CopyToDatabase (DBDeletion)
'Create a flag to tell the view from where that document has been proceed to be destroyed
DeletedDoc.FromDatabase = Document.ParentDatabase.FilePath
DeletedDoc.FromServer = Document.ParentDatabase.Server
Set Item = New NotesItem (DeletedDoc, "WhenDeleted", "")
Set Item.DateTimeValue = DateTime
'dont forget this property if you want to be able to use this item in the search
Item.IsSummary = True
Call DeletedDoc.Save (True, False)
Set Document = Collection.GetNextDocument (Document)
Loop
End Sub
Step 3 : purge and retreive (put them in the «FastDeletion» Database)
The agent for purge should work every day at 4 am to avoid conflic with admin process on server during night
Sub Initialize
Dim Session As New NotesSession
Dim Coll As NotesDocumentCollection
Dim DateTime As New NotesDateTime (Session.CurrentDatabase.Created)
'Adjust date for last 2 weeks
Set Coll = Session.CurrentDatabase.Search ("WhenDeleted < @Adjust (@Today;0; 0; -14; 0; 0; 0)", DateTime, 0)
'if there is at last one or more documents to purge
If Coll.Count > 0 Then Call Coll.RemoveAll (True)
End Sub
The action for retreive should be place in the «Deleted Documents» view
Sub Click(Source As Button)
Dim Session As New NotesSession
Dim Coll As NotesDocumentCollection
Dim DocRestore As NotesDocument
Dim Doc As NotesDocument
Dim DB As NotesDatabase
'Get all documents selected by user
Set Coll = Session.CurrentDatabase.UnprocessedDocuments
'if there is no document selected
If Coll.Count = 0 Then End
Set Doc = Coll.GetFirstDocument
Do While Not (Doc Is Nothing)
'Get the Database property
Set DB = Session.GetDatabase (Doc.FromServer (0), Doc.FromDatabase (0))
'Make the copy and delete the field used for deletion
Set DocRestore = Doc.CopyToDatabase (DB)
Call DocRestore.RemoveItem ("FromServer")
Call DocRestore.RemoveItem ("FromDatabase")
Call DocRestore.RemoveItem ("WhenDeleted")
Call DocRestore.Save (True, False)
Set Doc = Coll.GetNextDocument (Doc)
Loop
Call Coll.RemoveAll (True)
Dim WorkSpace As New NotesUIWorkSpace
Call WorkSpace.ViewRefresh
End Sub
Thema: Protokkolierung der Löschdokumente (Gelesen 2787 mal)