Da gab es vor Jahren mal einen Beitrag zu der Thematik. War noch zu R5-Zeiten. Der daraus resultierende Agent rettete mich damals bei der Migration von R4 auf R5 einige Male.
Sub Initialize
'Datenübernahme aus einer bestehenden Datenbank in eine neu angelegte Datenbank
'Autor: Heiko 1 Siebert/WBV SÜD/TerrWV/BMVg/DE
'Stand: 18.08.2004
Dim s As New NotesSession
Dim w As New NotesUIWorkspace
Dim destDb As New NotesDatabase("","")
Dim sourceDb As New NotesDatabase("","")
Dim AllDocs As NotesDocumentCollection
Dim AllDocsView As NotesView
Dim sourceDoc As NotesDocument
Dim destDoc As NotesDocument
Dim tempDoc As NotesDocument
Dim docCount As Variant
Dim current As Variant
Dim choices (0 To 2) As Variant
choices(0) = "Diese Datenbank"
choices(1) = "Lokale Databank"
choices(2) = "Datenbank auf einem Server"
' Quelldatenbank
sourceDbType = w.Prompt(PROMPT_OKCANCELLIST, "Wählen Sie den Datenbankort", _
"Wählen Sie den Datenbankort, von dem aus Sie Dokumente kopieren wollen:", _
choices(2), choices)
If sourceDbType = "" Then
Messagebox "Aktion wurde vom Benutzer abgebrochen"
Exit Sub
End If
If sourceDbType = choices(0) Then
Set sourceDb = s.CurrentDatabase
Else
If sourceDbType = choices(1) Then
sourceDbServer = ""
sourceDbNameReturn = w.OpenFileDialog(False, _
"Wählen Sie die Datenbank aus der Sie kopieren wollen:", "*.nsf", _
s.GetEnvironmentString("Directory", True))
If Isempty(sourceDbNameReturn) Then 'Wenn Nutzer auf ESC oder Abbrechen drückt
Msgbox("Abbruch: Ohne Angabe des Dateinamen kann die Aktion nicht durchgeführt werden!")
Exit Sub
End If
sourceDbName=SourceDbNameReturn(0)
Else
sourceDbServer = Inputbox("Geben Sie den Namen des Domino-Servers an")
sourceDbName = Inputbox("Geben Sie Pfad und Dateinamen der Datenbank (relativ zum DATA des Servers)")
If sourceDbName = "" Then
Msgbox("Abbruch: Ohne Angabe des Dateinamen kann die Aktion nicht durchgeführt werden!")
Exit Sub
End If
End If
If Not (sourceDb.Open(sourceDbServer, sourceDbName)) Then
Msgbox("Ich kann die angegebene Datei nicht finden oder öffnen: " + sourceDbName)
Exit Sub
End If
End If
' Zieldatenbank
destDbType = w.Prompt(PROMPT_OKCANCELLIST, "Ziel-Datenbank", _
"Wählen Sie den Ort der Datenbank, in die die Dokumente und Ordner hineinkopiert werden sollen", _
choices(2), choices)
If destDbType = "" Then
Messagebox "Abbruch durch Benutzer"
Exit Sub
End If
If destDbType = choices(0) Then
Set destDb = s.CurrentDatabase
Else
If destDbType = choices(1) Then
destDbServer = ""
destDbNameReturn = w.OpenFileDialog(False, _
"Bitte wählen Sie die Datenbank, aus der die Dokumente kopiert werden sollen:", "*.nsf", _
s.GetEnvironmentString("Directory", True))
If Isempty(destDbNameReturn) Then 'Wenn Nutzer auf ESC oder Abbrechen drückt
Msgbox("Abbruch: Ohne Angabe des Dateinamen kann die Aktion nicht durchgeführt werden!")
Exit Sub
End If
destDbName=destDbNameReturn(0)
Else
destDbServer = Inputbox("Geben Sie den Namen des DOMINO-Servers an")
destDbName = Inputbox("Wählen Sie den Ort der Datenbank, in die die Dokumente und Ordner hineinkopiert werden sollen")
If destDbName = "" Then
Msgbox("Abbruch: Ohne Angabe des Dateinamen kann die Aktion nicht durchgeführt werden!")
Exit Sub
End If
End If
If Not (destDb.Open(destDbServer,destDbName)) Then
Msgbox("Ich kann die angegebene Datenbank nicht finden oder öffnen: " + destDbName)
Exit Sub
End If
End If
If destdb.server=sourcedb.server And destdb.filename=sourcedb.filename And destdb.filepath=sourcedb.filepath Then
Msgbox("Quell- und Zieldatenbank sind zu unterschiedlich")
Exit Sub
End If
' Dokumenten-Collection in Quelldatenbank (nach Selektion) aufbauen
' anhand der Ansicht ($All)
AllDocsSelect = "@IsNotMember(""A""; ExcludeFromView) & IsMailStationery != 1" + _
"& Form != ""Group"" & Form != ""Person"""
Set AllDocs = sourceDb.Search(AllDocsSelect, Nothing, 0)
' Anzeige des Fortschritts der Aktionen, sofern möglich
docCount = AllDocs.Count
current = 0
Print Cstr(Round(current / docCount * 100, 0)) + "% copied"
' Alle Ordner, die in der Zieldatenbank nicht vorhanden sind werden durchgegangen (auch Systemordner) sofern nicht $Inbox
Forall folder In sourceDb.Views
If folder.IsFolder And (Instr(1, folder.Name, "(", 0)<>1 Or folder.Name="($Inbox)") Then
' Sicherstellung, das auch leere Ordner übernommen werden
' um die Struktur so zu belassen, wie diese vorher war
Set destFolder = destDb.GetView(folder.Name)
If destFolder Is Nothing Then
Set sourceFolder = sourceDb.GetDocumentByUNID(folder.UniversalID)
Call sourceFolder.CopyToDatabase(destDb)
Set destFolder = destDb.GetView(folder.Name)
If destFolder Is Nothing Then
Msgbox("Ich kann in der neuen Datenbank keine Ordner erstellen!")
Exit Sub
End If
End If
' Durchgang aller Dokumente im jeweiligen Ordner
Set sourceDoc = folder.GetFirstDocument
While Not (sourceDoc Is Nothing)
Set destDoc = sourceDoc.CopyToDatabase(destDb)
' Kopieren der Dokumente eines Ordners in die Zieldatenbank in den gleichnamigen Ordner
Call destDoc.PutInFolder(folder.Name, True)
' Entfernen des bearbeiteten Dokuments aus der aufgebauten Collection der Ansicht ($All) in der Datenbank
Set tempDoc = AllDocs.GetDocument(sourceDoc)
Set sourceDoc = folder.GetNextDocument(tempDoc)
Call AllDocs.DeleteDocument(tempDoc) 'remove from collection
' Anzeige des Fortschritts der Aktion, sofern möglich
current = current + 1
Print Cstr(Round(current / docCount * 100, 0)) + "% kopiert"
Wend
End If
End Forall
' Kopieren der Dokumente, die in keinem Ordner vorhanden sind in die Zieldatenbank
Set sourceDoc = AllDocs.GetFirstDocument
While Not (sourceDoc Is Nothing)
Call sourceDoc.CopyToDatabase(destDb)
' Anzeige des Fortschritts der Aktion, sofern möglich
current = current + 1
Print Cstr(Round(current / docCount * 100, 0)) + "% kopiert"
Set sourceDoc = AllDocs.GetNextDocument(sourceDoc)
Wend
'That´s all :-)
Msgbox("Dokumente und Ordner wurden kopiert. Schliessen Sie die neue Datenbank (falls diese geöffnet ist) und öffnen Sie diese wieder!")
End Sub
Ich baumel die Datenbank mit dem Agent mal hier ran. Hab's eben mal mit meinem Client (R7.0.2) gecheckt. Scheint auch heute noch zu funktionieren :-)
Thema: Komplette Ordnerstruktur in andere Mail-Datenbank kopieren? (Gelesen 23181 mal)