Ich schäme mich für den gefrickelten Kot :-[
Egal...
Sub Initialize
Dim ziel As NotesDatabase
Dim quelle As NotesDatabase
Dim s As New NotesSession
Dim zielpfad As String
Dim quellpfad As String
zielpfad = "P:\data\names.nsf"
quellpfad = "P:\lotus\names.nsf"
Print "Start"
'###########################
' ziel und quell-db finden
Set ziel = s.GetDatabase("",zielpfad)
If ziel Is Nothing Then
Exit Sub
End If
Set quelle = s.GetDatabase("",quellpfad)
If quelle Is Nothing Then
Exit Sub
End If
'###########################
Dim quellcoll As NotesViewEntryCollection
Dim zielcoll As NotesViewEntryCollection
Dim doc As NotesDocument
Dim ndoc As NotesDocument
Dim entry As NotesViewEntry
Dim nentry As NotesViewEntry
Dim personview As NotesView
' alle doks in der ziel-db löschen, sowohl gruppen als auch kontakte
' kontakte
Set personview = ziel.GetView("People")
Set zielcoll = personview.AllEntries
If Not zielcoll.Count = 0 Then
Call zielcoll.RemoveAll(True)
End If
Print "Kontakte im Ziel gelöscht"
' gruppen
Set personview = ziel.GetView("Groups")
Set zielcoll = personview.AllEntries
If Not zielcoll.Count = 0 Then
Call zielcoll.RemoveAll(True)
End If
Print "Gruppen im Ziel gelöscht"
Stop
' alle doks aus der quelle in das ziel schieben
Set personview = quelle.GetView("People")
Set quellcoll = personview.AllEntries
If quellcoll.Count = 0 Then
Print "Es gibt keine Kontakte zu kopieren"
Goto gruppen
End If
' anlegen
Set entry = quellcoll.GetFirstEntry
Set doc = entry.Document
Do
Print "Kopiert Kontakt " & doc.lastname(0)
Call doc.CopyToDatabase(ziel)
Set nentry = quellcoll.GetNextEntry(entry)
If Not nentry Is Nothing Then
Set entry = nentry
Set ndoc = nentry.Document
Set doc = ndoc
Else
Exit Do
End If
Loop Until doc Is Nothing
Set doc = Nothing
Set entry = Nothing
Print "Fertig mit den Kontakten"
Stop
gruppen:
Set personview = quelle.GetView("Groups")
Set quellcoll = personview.AllEntries
If quellcoll.Count = 0 Then
Print "Es gibt keine Gruppen zu kopieren"
Goto weiter
End If
Set entry = quellcoll.GetFirstEntry
Set doc = entry.Document
Do
If doc.listname(0) = "LocalDomainServers" Or doc.listname(0) = "OtherDomainServers" Then
Goto gr_weiter
End If
Print "Kopiert Gruppe " & doc.listname(0)
Call doc.CopyToDatabase(ziel)
gr_weiter:
Set nentry = quellcoll.GetNextEntry(entry)
If Not nentry Is Nothing Then
Set entry = nentry
Set ndoc = nentry.Document
Set doc = ndoc
Else
Exit Do
End If
Loop Until doc Is Nothing
Print "Fertig mit den Kontakten"
weiter:
Print "Fertig"
Exit Sub
End Sub
Matthias