Hallo,
wahrscheinlich kann man die Archivdatenbank selbst wieder in die Originaldatenbank zurückarchivieren. Also die Archivdatenbank des Archivs ist die Originaldatenbank. Müsste eigentlich gehen, hab ich aber noch nicht probiert, also erst einmal mit einer Testdatenbank versuchen.
Wenn das nichts bringt, hab ich vor ein paar Jahren mal eine Funktion geschrieben, mit der Dokumente aus einer Datenbank in eine andere Datenbank kopiert werden und dabei die Dokumente wieder in die richtigen Ordner geschoben werden. Habs schon lange nicht mehr gemacht, aber sollte immer noch funkionieren.
' ************************************************************************************
' Funktion: CopyDatabaseDocs, CopyDatabaseDocsUI
' Parameter: sourceDB Quelldatenbank
' targetDB Zieldatenbank
' Rückgabe: -
'
' Bedeutung:
' ==========
' Mit dieser Funkion werden alle Dokumente aus einer Datenbank in eine andere
' Datenbank kopiert. Hierbei werden die Dokumente in der Zieldatenbank wieder in
' genau die gleichen Ordner geschoben.
' ************************************************************************************
Sub CopyDatabaseDocs(sourceDB As NotesDatabase, targetDB As NotesDatabase)
Dim session As New NotesSession
Dim sourceFolder As NotesView ' Ordner (und Ansichten) in der Quelle
Dim sourceDocs As NotesDocumentCollection ' Alle Doklumente der Quelle
Dim sourceDoc As NotesDocument ' Aktuelle Kopierdokument in der Quelle
Dim targetDocs As NotesDocumentCollection ' Alle Dokumente für einen Ordner
Dim targetDocList List As NotesDocument ' Alle kopierten Dokumente mit NoteID-Index
Dim i As Long
Dim n As Long
If (sourceDB Is Nothing) Then Msgbox "Die Quelldatenbank konnte nicht geöffnet werden!", 16, "Fehler": Exit Sub
If (targetDB Is Nothing) Then Msgbox "Die Zieldatenbank konnte nicht geöffnet werden!", 16, "Fehler": Exit Sub
If (Not(sourceDB.IsOpen)) Then Msgbox "Die Quelldatenbank konnte nicht geöffnet werden!", 16, "Fehler": Exit Sub
If (Not(targetDB.IsOpen)) Then Msgbox "Die Zieldatenbank konnte nicht geöffnet werden!", 16, "Fehler": Exit Sub
' ===============================================================================
' 1. Alle Dokumente kopieren und Targetliste erstellen
' On Error ist notwendig, weil Papierkorbdokumente nicht kopiert werden
' ===============================================================================
On Error Resume Next
Set sourceDocs = sourceDB.AllDocuments
Set sourceDoc = sourceDocs.GetFirstDocument()
n = sourceDocs.Count
While (Not(sourceDoc Is Nothing))
i = i + 1
Print "Kopiere Dokument " & i & " / " & n
Set targetDocList(sourceDoc.NoteID) = sourceDoc.CopyToDatabase(targetDB)
Set sourceDoc = sourceDocs.GetNextDocument(sourceDoc)
Wend
' ===============================================================================
' 2. Alle Ordner durchlaufen und mit Targetliste die Dokumente verschieben
' ===============================================================================
n = Ubound(sourceDB.Views)
i = 0
Forall folder In sourceDB.Views
i = i + 1
Set sourceFolder = folder
If (sourceFolder.IsFolder) Then
Print "Aktualisiere Order " & i & " / " & n & ": " & sourceFolder.Name
Set targetDocs = targetDB.Search("@False", Nothing, 0)
Set sourceDoc = sourceFolder.GetFirstDocument()
While (Not(sourceDoc Is Nothing))
Call targetDocs.AddDocument(targetDocList(sourceDoc.NoteID))
Set sourceDoc = sourceFolder.GetNextDocument(sourceDoc)
Wend
Call targetDocs.PutAllInFolder(sourceFolder.Name, True)
End If
End Forall
End Sub
Ist wieder mal das berüchtigte "On Error Resume Next" drin, aber vielleicht hilt Dir das ja. Kannst den Code ja entsprechend verändern
Gruß,
Joachim