Bei uns ist das Wiederherstellen von gelöschten Ordnern in Maildatenbanken (leider) Tagesgeschäft. Unsere Sicherungslösung stellt dem Anwender dafür temporär ein Backup seiner Mail-Db (mit anderer Replica-ID) zur Verfügung. In dieses Backup wird automatisch ein Agent eingefügt, der es dem Anwender ermöglicht gewünschte Ordnerzuordnungen in der produktiven Mail-DB wiederherzustellen. Dazu wird durch alle Einträge im Ordner des Backups geloopt und anhand der UNID das Dokument in der produktiven DB gesucht und in einen neuen Ordner gleichen Namens gepackt.
Die Automatisierung hat dem Ganzen bei uns seinen Schrecken genommen.
Hier zur Info der Code unseres Agenten:
Sub Initialize
Dim session As New NotesSession
Dim ws As New NotesUIWorkspace
Dim db As NotesDatabase
Dim profiledoc As NotesDocument
Dim zdb As New NotesDatabase("", "")
Dim doc As NotesDocument
Dim newdoc As NotesDocument
Dim dbname As String
Dim servername As String
Dim view_name As String
Dim ncol As NotesNoteCollection
Dim i As Integer
Dim nid As String
Dim view As NotesView
Dim note As NotesDocument
Dim FolderArray() As String
Dim auswahl As Variant
On Error Goto Fehler
Set db = session.CurrentDatabase
Set profiledoc = db.GetProfileDocument("Profil")
' Pfad der aktuellen DB aus Profil auslesen (wird beim Erstellen der Sicherung gesetzt)
dbname = Strright(profiledoc.TSMSourceDB(0), "!!")
servername = Strleft(profiledoc.TSMSourceDB(0), "!!")
If dbname = "" Or servername = "" Then
Msgbox "Auf den Pfad der aktuellen Mail-DB kann nicht zugegriffen werden !", 16, "Fehler"
Exit Sub
End If
If Not zdb.Open(servername, dbname) Then
Msgbox "Die aktuelle Maildatenbank (" + servername + "!!" + dbname + ") kann nicht geöffnet werden !", 16, "Fehler"
Exit Sub
End If
Print "Vorhandene Ordner werden gelesen ..."
Set ncol = db.CreateNoteCollection(False)
ncol.SelectFolders = True
Call ncol.BuildCollection()
nID = ncol.GetFirstNoteId
Redim FolderArray(ncol.Count) As String
For i = 1 To ncol.Count
Set note = db.GetDocumentByID(nID)
If Not note Is Nothing Then
view_name = Trim(note.GetItemValue("$TITLE")(0))
If Instr(view_name, "|") Then view_name = Trim(Strleft(view_name, "|"))
' nur private Ordner und den Eingang zur Auswahl anbieten
If view_name = "($Inbox)" Then
FolderArray( i ) = "- Eingang -"
Elseif Left(view_name, 1) <> "(" Then
FolderArray( i ) = view_name
End If
End If
nID = ncol.GetNextNoteId(nID)
Next
' Alphabetisch sortieren
Call BubbleSort(FolderArray)
Print ""
' Anwender zur Auswahl stellen
auswahl = ws.Prompt( prompt_okcancellistmult, "Ordner", "Bitte wählen Sie die wiederherzustellenden Ordner aus", "", Fulltrim(FolderArray))
If Isempty(auswahl) Then Exit Sub
Print "Ordner und Dokumentzuordnungen werden wiederhergestellt ..."
' Auswahl abarbeiten
Forall x In auswahl
view_name = x
If view_name = "- Eingang -" Then view_name = "($Inbox)" ' Ausnahme wegen anderem Anzeigenamen
' Ordner in Sicherung öffnen, durch alle Dokumente iterieren und deren Ebenbild in aktueller Db in den gleichen Ordner legen (ggf. wird der Ordner dort angelegt)
Set view = db.GetView( view_name )
If Not view Is Nothing Then
Set doc = view.GetFirstDocument
Do While Not doc Is Nothing
On Error Resume Next
Set newdoc = zdb.GetDocumentByUNID(doc.UniversalID)
On Error Goto Fehler
If Not newdoc Is Nothing Then
Call newdoc.PutInFolder(view_name, True)
End If
Set doc = view.GetNextDocument(doc)
Loop
End If
End Forall
Msgbox "Wiederherstellung der Ordner abgeschlossen. Bitte schließen Sie Ihre aktuelle Mail-DB und öffnen Sie sie erneut, um die Ordner in der Navigation sichtbar zu machen !", 0, "Ordnerzuordnungen wiederherstellen"
Print ""
Exit Sub
Fehler:
Msgbox "Fehler beim Übertragen der Ordnerzuordnungen: " + Error$ + " in Zeile " + Str(Erl), 16, "Fehler"
Exit Sub
End Sub
Private Sub BubbleSort(Array() As String)
' sortiert die Werte im Array() in aufsteigender Reihenfolge mit dem Bubble-Sort-Verfahren
Dim i As Integer
Dim j As Integer
Dim t As String
' Schleife über alle Elemente vom ersten bis zum vorletzten
For i = Lbound(array) To Ubound(array) - 1
' Schleife über alle weiteren Elemente
For j = i + 1 To Ubound(array)
' Vergleichen der weiteren Elemente und möglicherweise vertauschen
If array( i ) > array( j ) Then
t = array( i )
array( i ) = array( j )
array( j ) = t
End If
Next
Next
End Sub
Viele Grüße
André