HI@all,
habe mal wieder ne kleine Frage.... ;)
Ich möchte eine DB erstellen in der Alle DBs eines Servers aufgelistet sind, und mit einem 2.ten Server abgeglichen werden ob diese DB dort ebenfalls vorhanden ist.
Dabei sollen aber auch noch die Datenbank Eigenschaften der beiden DBs auf den verschiedenen Servern angezeigt werden.
Der Abgleich soweit klappt ganz gut, jedoch ist mir aufgefallen das wenn ich an bestimmte Eigenschaften der Datenbanken möchte, muss ich die DBs erst öffnen. (z.B. ACL, Erstellt am etc.)
Mit dem Befehl db.Open("","") klappt das soweit auch, jedoch mit nicht mehr als 3 Datenbanken, danach schmirt Notes immer wieder mit nem Roten Fenster ab.
Ich nehme an, das zuviele DBs offen sind und somit zuviel Speicher verbraten wird, hat jemand von euch ne alternative für meinen Code bzw. nen Rat wie ich zb. die geöffneten DBs wieder schließen kann (da es ja kein db.close gibt).
Ich hoffe die Fragestellung war klar.
Freue mich schon auf ne Antwort bis dann CU
P.S.
Der Code:
On Error Goto ERRORSTEP
REM Umgebung
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
REM Standard
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
If doc.Server1(0) <> "" And doc.Server2(0)<> "" And doc.Server1(0) <> doc.Server2(0) Then
Print "Vergleich der Server gestartet!"
Dim DBDir1 As New NotesDbDirectory(doc.Server1(0))
Dim DBDir2 As New NotesDbDirectory(doc.Server2(0))
Dim DB1 As NotesDatabase
Dim DB2 As NotesDatabase
Dim i As Integer
Dim DocNew As NotesDocument
Set DB1 = DBDir1.GetFirstDatabase(1246)
Print "Lade Daten vom Server " & Cstr(DB1.Server)
i = 0
If Not db1 Is Nothing Then
Do Until db1 Is Nothing
Err = 0
Call db1.Open("","")
Set DocNew = db.CreateDocument
DocNew.Form = "mDB"
DocNew.Server1 = db1.Server
DocNew.TitelS1 = db1.Title
DocNew.PfadS1 = db1.FilePath
DocNew.ReplikIDS1 = Cstr(db1.ReplicaID)
DocNew.groesseS1 = Cstr(db1.Size)
If Err <> 4060 Then
DocNew.ErstelltS1 = Cstr(db1.Created)
DocNew.GeaendertS1 = Cstr(db1.LastModified)
DocNew.FixUpS1 = Cstr(db1.LastFixup)
Else
DocNew.ErstelltS1 = "Keine Berechtigung"
DocNew.GeaendertS1 = "Keine Berechtigung"
DocNew.FixUpS1 = "Keine Berechtigung"
End If
DocNew.TitelS2 = "N.V."
DocNew.PfadS2 = "N.V."
DocNew.ReplikIDS2 = "N.V."
DocNew.groesseS2 = "N.V."
DocNew.ErstelltS2 = "N.V."
DocNew.GeaendertS2 = "N.V."
DocNew.FixUpS2 = "N.V."
Set DB2 = DBDir2.GetFirstDatabase(1246)
DocNew.Server2 = db2.Server
Do Until db2 Is Nothing
If db1.FilePath = db2.FilePath Then
Err = 0
Call db2.Open("","")
DocNew.TitelS2 = db2.Title
DocNew.PfadS2 = db2.FilePath
DocNew.ReplikIDS2 = Cstr(db2.ReplicaID)
DocNew.groesseS2 = Cstr(db2.Size)
If Err <> 4060 Then
DocNew.ErstelltS2 = Cstr(db2.Created)
DocNew.GeaendertS2 = Cstr(db2.LastModified)
DocNew.FixUpS2 = Cstr(db2.LastFixup)
Else
DocNew.ErstelltS2 = "Keine Berechtigung"
DocNew.GeaendertS2 = "Keine Berechtigung"
DocNew.FixUpS2 = "Keine Berechtigung"
End If
Exit Do
End If
Set db2 = dbdir2.GetNextDatabase()
Loop
DocNew.Status = "Abgeschlossen"
Call DocNew.Save(True,False)
i = i +1
If i >= 5 Then Exit Do
Set db1 = dbdir1.GetNextDatabase()
Loop
End If
Print "Vergleich der Server erfolgreich beendet!"
Else
Messagebox ("Bitte geben Sie 2 verschiedene Server ein die miteinander verglichen werden sollen.")
End If
Exit Sub
ERRORSTEP:
If Err = 4060 Then Resume Next
Msgbox "Es ist ein Fehler aufgetreten." & Chr(10) & Chr(10) _
& "Fehlermeldung: " & Error$ & Chr(10) _
& "Fehlernummer: " & Err & Chr(10) _
& "Codezeile: " & Erl & Chr(10) _
,64,"Error"
Print Cstr(Error$) & " - " & Cstr(Err) & " - " & Cstr(Erl)
Exit Sub
"OSVBlockAddr: Bad VBlock handle"
kann mir jemand von euch nen Tip geben warum das so passiert?
habe sogar schon testhalber mal ne Begrenzun eingebaut....
Code: (Dies ist der Originalcode der das Rote Fenster bringt....)
Sub ServerVergleichNewDok_V2
On Error Goto ERRORSTEP
REM Umgebung
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
REM Standard
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim db As NotesDatabase
Set db = session.CurrentDatabase
Set uidoc = workspace.CurrentDocument
Set doc = uidoc.Document
Dim s2 As Integer
If doc.Server1(0) <> "" And doc.Server2(0)<> "" And doc.Server1(0) <> doc.Server2(0) Then
Print "Vergleich der Server gestartet!"
Dim DBDir1 As New NotesDbDirectory(doc.Server1(0))
Dim DBDir2 As New NotesDbDirectory(doc.Server2(0))
Dim DB1Dir As NotesDatabase
Dim DB1 As NotesDatabase
Dim DB2 As NotesDatabase
Dim Item1 As Notesitem
Dim Item2 As Notesitem
Dim intRCS1 As Integer
Dim lngDBHandleS1 As Long
Dim intRCS2 As Integer
Dim lngDBHandleS2 As Long
Dim i As Integer
Dim DocNew As NotesDocument
Dim docCol As NotesDocumentCollection
Set DB1Dir = DBDir1.GetFirstDatabase(1246)
Print "Lade Daten vom Server " & Cstr(DB1Dir.Server)
i = 0
If Not db1Dir Is Nothing Then
Do Until db1Dir Is Nothing
Set DB1 = New NotesDatabase(DB1Dir.server,DB1Dir.filename)
Set DocNew = db.CreateDocument
DocNew.Form = "mDB"
DocNew.Server1 = db1.Server
DocNew.TitelS1 = db1.Title
DocNew.PfadS1 = db1.FilePath
DocNew.ReplikIDS1 = Cstr(db1.ReplicaID)
DocNew.groesseS1 = Cstr(db1.Size)
DocNew.AnzahlS1 = Cstr(db1.AllDocuments.Count)
DocNew.TitelS2 = "N.V."
DocNew.PfadS2 = "N.V."
DocNew.ReplikIDS2 = "N.V."
DocNew.groesseS2 = "N.V."
DocNew.ErstelltS2 = "N.V."
DocNew.GeaendertS2 = "N.V."
DocNew.FixUpS2 = "N.V."
DocNew.ANzahlS2 = "N.V."
Set DB2 = DBDir2.GetFirstDatabase(1246)
DocNew.Server2 = db2.Server
s2 = 0
Print "Suche auf Server 2 nach Datenbank"
Do Until db2 Is Nothing
If db1.FilePath = db2.FilePath Then
Print "Datenbank gefunden - Trage Werte ein"
Set DB2 = New NotesDatabase(DB2.server,DB2.filename)
DocNew.TitelS2 = db2.Title
DocNew.PfadS2 = db2.FilePath
DocNew.ReplikIDS2 = Cstr(db2.ReplicaID)
DocNew.groesseS2 = Cstr(db2.Size)
DocNew.AnzahlS2 = Cstr(db2.AllDocuments.Count)
Exit Do
End If
s2 = s2 +1
If s2 >= 10 Then Exit Do
Set db2 = dbdir2.GetNextDatabase()
Loop
DocNew.Status = "Abgeschlossen"
Call DocNew.Save(True,False)
Set DB1 = Nothing
i = i +1
If i >= 3 Then Exit Do
' Sleep(15)
Print "Nächste Datenbank auf Sersve 1"
Set db1Dir = dbdir1.GetNextDatabase()
Sleep(10)
Loop
End If
Print "Vergleich der Server erfolgreich beendet!"
Else
Messagebox ("Bitte geben Sie 2 verschiedene Server ein die miteinander verglichen werden sollen.")
End If
Exit Sub
ERRORSTEP:
If Err = 4060 Then Resume Next
Msgbox "Es ist ein Fehler aufgetreten." & Chr(10) & Chr(10) _
& "Fehlermeldung: " & Error$ & Chr(10) _
& "Fehlernummer: " & Err & Chr(10) _
& "Codezeile: " & Erl & Chr(10) _
,64,"Error"
Print Cstr(Error$) & " - " & Cstr(Err) & " - " & Cstr(Erl)
Exit Sub
End Sub