Ich finde solche fertigen Tools meistens unvollständig und baue mir sowas lieber schnell selber. Wenn in dem genannten Beispiel 50 Datenbanken kopiert werden müssen, muss im Nachgang meist doch noch was geändert werden, z.B. der Datenbanktitel, und dann kann ich es gleich von Hand machen.
Zum Kopieren von Datenbanken incl. Änderung des Datenbanktitels habe ich vor Jahren dieses Script erstellt, Datengrundlage ist eine Exceldatei, in der Quelldatenbank, Zieldatenbank und Titel der Zieldatenbank genannt werden. Das Script einfach in einen Agenten einer leeren Datenbank kopieren und über Aktionen starten. Man gibt den Hauptserver und evtl. die Server an, auf die die Kopien zusätzlich repliziert werden sollen (z.B. beim Cluster), diese Einstellungen merkt sich das Tool in der Datenbank. Danach wählt man die Exceltabelle mit den Daten aus.
Vielleicht kann es jemand gebrauchen ...
Function Einstelldokument (db As NotesDatabase) As NotesDocument
Dim col As NotesDocumentCollection
Set col = db.Search (|Form = "einstellungen"|, Nothing, 0)
If col.Count = 0 Then
Set Einstelldokument = New NotesDocument (db)
Else
Set Einstelldokument = col.GetFirstDocument
End If
Einstelldokument.Form = "einstellungen"
End Function
Sub Initialize
'Kopiert Datenbanken anhand einer Exceltabelle
'Beginnt in Zeile 2
'Spalte 1: Quelldateiname
'Spalte 2: Zieldateiname
'Spalte 3: Datenbanktitel
'Spalte 4: Protokoll
Const art = "DBKopieren"
Const protokollspalte = "D"
Dim session As New NotesSession
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Dim einstelldoc As NotesDocument
Set einstelldoc = Einstelldokument (db)
Dim trenn As String
trenn = Chr (13) & Chr (10)
Dim msg As String
Dim server As String
server = Inputbox ("Bitte geben Sie den Namen des Hauptservers ein", art, einstelldoc.Server (0))
If server = "" Then
Exit Sub
End If
If einstelldoc.Server (0) <> server Then
einstelldoc.Server = server
End If
msg = "Datenbanken werden erstellt auf " & server
Dim i As Integer
i = -1
Dim replikserver As Variant
Redim replikserver (0)
Do
i = i + 1
Redim Preserve replikserver (i)
replikserver (i) = Inputbox ("Bitte geben Sie den Namen des " & i + 1 & ". Replikservers ein (LOKAL für lokale Replik, nichts für keinen weiteren Server)", art, einstelldoc.GetItemValue ("Replikserver" & i) (0))
If replikserver (i) <> "" Then
If einstelldoc.GetItemValue ("Replikserver" & i) (0) <> replikserver (i) Then
Call einstelldoc.ReplaceItemValue ("Replikserver" & i, replikserver (i))
End If
msg = msg & trenn & i + 1 & ". Replik auf " & replikserver (i)
End If
Loop Until replikserver (i) = ""
Call einstelldoc.Save (True, True)
If Msgbox (msg & trenn & trenn & "Wollen Sie fortfahren?", 32 + 4, art) = 7 Then
Exit Sub
End If
Dim workspace As New NotesUIWorkspace
Dim files As Variant
files = workspace.OpenFileDialog (True, "Bitte wählen Sie die Exceltabelle aus", art, "")
If Not Isarray (files) Then
Exit Sub
End If
If Ubound (files) > 0 Then
Msgbox "Sie dürfen nur eine Datei auswählen", 16, "Fehler"
Exit Sub
End If
Dim excel As Variant
Set excel = CreateObject ("Excel.Application")
excel.Application.Visible = True
excel.Workbooks.Open (files (0))
Dim quelledateiname As String
Dim zieldateiname As String
Dim titel As String
Dim quelledb As NotesDatabase
Dim zieldb As NotesDatabase
Dim flagfehler As Integer
Dim count As Integer
Dim zeile As Integer
zeile = 2
On Error Goto Fehler
Do
excel.Range ("A" & zeile).Select
quelledateiname = excel.ActiveCell.FormulaR1C1
excel.Range ("B" & zeile).Select
zieldateiname = excel.ActiveCell.FormulaR1C1
excel.Range ("C" & zeile).Select
titel = excel.ActiveCell.FormulaR1C1
excel.Range (protokollspalte & zeile).Select
If quelledateiname = "" Or zieldateiname = "" Then
Exit Do
End If
Set quelledb = New NotesDatabase (server, quelledateiname)
If Not quelledb.IsOpen Then
excel.Range (protokollspalte & zeile).Select
excel.ActiveCell.FormulaR1C1 = "Quelle konnte nicht geöffnet werden"
flagfehler = True
Else
Set zieldb = New NotesDatabase (server, zieldateiname)
If zieldb.IsOpen Then
excel.Range (protokollspalte & zeile).Select
excel.ActiveCell.FormulaR1C1 = "Ziel existiert bereits"
flagfehler = True
Else
Print "Verarbeite Zeile " & zeile
Set zieldb = quelledb.CreateCopy (server, zieldateiname)
If zieldb.IsOpen Then
If titel <> "" Then
zieldb.Title = titel
End If
Forall rserver In replikserver
If rserver <> "" Then
If Lcase (rserver) = "lokal" Then
rserver = ""
End If
Call zieldb.CreateReplica (rserver, zieldateiname)
End If
End Forall
excel.Range (protokollspalte & zeile).Select
excel.ActiveCell.FormulaR1C1 = "OK"
count = count + 1
End If
End If
End If
zeile = zeile + 1
Loop
excel.Range ("A" & zeile).Select
If flagfehler Then
excel.ActiveCell.FormulaR1C1 = count & " Datenbanken kopiert, es sind Fehler aufgetreten"
Else
excel.ActiveCell.FormulaR1C1 = count & " Datenbanken kopiert"
End If
excel.Range ("A" & zeile + 1).Select
Exit Sub
Fehler:
excel.Range (protokollspalte & zeile).Select
excel.ActiveCell.FormulaR1C1 = Err & " " & Error
Resume Next
End Sub
Thema: Neue Datenbanken per Batch anlegen? (Gelesen 2645 mal)