Hallo,
habe da ein Problem mit dem Verschieben (Archivieren) von Dokumenten.
Ich habe einen Agenten in LS geschrieben, der mir aus einer DB alle Dokumente die vor einem best. Datum Created worden sind in eine sog. Archiv-DB kopieren und dann löschen soll.
Der Agent läuft los, geht ca. 15.000 - 20.000 Dokumente durch, dann beendet er sich ohne Fehlermeldung.
Ich habe nun schon einige Print's eingebaut, damit ich sehe, wann er abbricht.
Der "Print "Set Doc = DocNext"" wird noch ausgeführt, dann nichts mehr. Vermutlich liegt es an dem
"Set Doc = DocNext".
In der Archiv-DB sind dann auch die 15.000 - 20.000 Dokumente vorhanden, und in der Orginal DB gelöscht.
Ich sehe leider keinen Fehler, hoffentlich kann mir da jemand helfen.
Danke
Thomas
Agent
----------------------------------------------------------------------------
Sub CreateArchiv
On Error Goto ErrorMail
Print "Agent CreateArchiv Start"
Dim Session As New NotesSession
Dim DB As NotesDatabase
Dim proDoc As NotesDocument
Dim Col As NotesDocumentCollection
Dim Doc As NotesDocument
Dim DocNext As NotesDocument
Dim DBArchiv As NotesDatabase
Dim DBArchivAgent As NotesAgent
Dim DocMail As NotesDocument
Dim rtitem As NotesRichTextItem
Dim strArchivMonate As String
Dim strArchivPfad As String
Dim strArchivLastDate As String
Dim strMonth As String
Dim strYear As String
Dim cnt As Double
Dim DBReplica As NotesDatabase
Dim strArchivDB As String
Dim strClusterServer As Variant
Dim i As Integer
Dim agentArray( 1 To 30) As String
Dim agent As NotesAgent
Dim agcnt As Integer
Dim x As Integer
agcnt = 0
cnt = 1
Dim AktDatum As New NotesDateTime(Now)
.......
Set Col = DB.AllDocuments
Print "Anz. Dokumente: " & Col.Count
Set Doc = Col.GetFirstDocument
Print "Alle Dokumente bis Erstelldatum " & Aktdatum.DateOnly & " werden archiviert."
While Not (Doc Is Nothing)
Set DocNext = Col.GetNextDocument(Doc)
Dim datDocCreate As New NotesDateTime(Doc.Created)
If AktDatum.TimeDifference(datDocCreate) > 0 Then
' Print "Dokument kopieren"
Call doc.CopyToDatabase( DBArchiv )
' Print "Dokumet löschen"
Call doc.Remove( False )
cnt = cnt + 1
Print Cstr(cnt)
End If
Print "Set Doc = DocNext"
Set Doc = DocNext
Print "nach Set"
Wend
Print "Nach Wend"
ErrorMail:
Call ErrorMailSend("ERROR:" & Err() & ": " & Error() & ", in Line " & Erl())
Print "Error " & Err() & ": " & Error()& ", in Line " & Erl()
End Sub