Hier wäre mal ein Beispiel Scritp was nur das Verzeichnis org und mail berücksichtigt:
Sub Initialize
Dim Session As NotesSession
Dim ws As NotesUIWorkspace
Dim uidoc As NotesUIDocument
Dim doc As NotesDocument
Dim NAB As NotesDatabase
Dim NABServer As String
Dim NABView As NotesView
Dim NABDoc As NotesDocument
Dim ServerMailFile As NotesDatabase
Dim ServerDirectory As NotesDbDirectory
Dim NABCollectList List As NotesDocumentCollection
Dim FileFromNABList List As String
Dim FileFromServerList List As ServerFileType
Set session = New NotesSession
Set ws = New NotesUIWorkspace
Set uidoc = ws.CurrentDocument
Set doc = uidoc.Document
'Specify the server from which to get user information
If doc.serverver(0)="" Or doc.ServerToSearch(0)="" Then
Msgbox "Kein Server oder Verzeichnis angegeben!"
Exit Sub
End If
NABServer = doc.serverver(0)
'Open the Public Address Book
Print "Adressbuch öffnen"
Set NAB = Session.GetDatabase(NABServer,"names.nsf")
If NAB.IsOpen Then
'Server\Mail users view and place all the documents in a collection (one for each server)
Set NABView = NAB.GetView("Server\Mail Users")
FileCount%=0
Print "Ansicht ""Server\Mail Users"" öffnen"
'For each speficied server, find all the mail files (you might need to edit this section to specify the correct mail directory)
Forall TKServer In doc.ServerToSearch
Set ServerDirectory = Session.GetDbDirectory(Cstr(TKServer))
Set ServerMailFile = ServerDirectory.GetFirstDatabase(DATABASE)
While Not ServerMailFile Is Nothing
' test=Left$(Ucase$(ServerMailFile.FilePath),5) = "MAIL\"
' test2=Left$(Ucase$(ServerMailFile.FilePath),5) = "ORG\"
If Left$(Ucase$(ServerMailFile.FilePath),5) = "MAIL\" Or Left$(Ucase$(ServerMailFile.FilePath),4) = "ORG\" Then 'And Mid$(Ucase$(ServerMailFile.FilePath),6,7) <> "CLUSTER" Then
' Änderung 1 13.01.03 DH:
' es gibt auch DBen, die nicht auf ".NSF" enden (z.B. ".NS4"), deshalb robustere Selektion
' alter Code
' FileFromServerList(FileCount%).FilePath = Left$(Ucase$(ServerMailFile.FilePath),Instr(1,Ucase$(ServerMailFile.FilePath),".NSF")-1)
' neuer Code
FileFromServerList(FileCount%).FilePath = Left$(Ucase$(ServerMailFile.FilePath),Instr(1,Ucase$(ServerMailFile.FilePath),".NS")-1)
' Ende Änderung 1 13.01.03
FileFromServerList(FileCount%).ServerName = TKServer
FileFromServerList(FileCount%).Owner = ServerMailFile.Title
End If
Set ServerMailFile = ServerDirectory.GetNextDatabase()
FileCount%=FileCount%+1
Wend
End Forall
'Create an array list of the files in the mail directory
i=0
Forall TKServer In doc.ServerToSearch
Set NABCollectList(i) = NABView.GetAllDocumentsByKey(Cstr(TKServer),False)
i=i+1
End Forall
'For all the users in the Public address book for the same server, create an array list
FileCount%=0
Forall NABCollect In NABCollectList
For NABCount% = 1 To NABCollect.count
Set NABDoc = NABCollect.GetNthDocument(NABCount%)
If Right$(Ucase$(NABDoc.MailFile(0)),4) = ".NSF" Then
' Änderung 2 13.01.03 DH:
' es gibt auch DBen, die nicht auf ".NSF" enden (z.B. ".NS4"), deshalb robustere Selektion
' alter Code
' FileFromNABList(FileCount%) = Left$(Ucase$(NABDoc.MailFile(0)),Instr(1,Ucase$(NABDoc.MailFile(0)),".NSF")-1)
' neuer Code
FileFromNABList(FileCount%) = Left$(Ucase$(NABDoc.MailFile(0)),Instr(1,Ucase$(NABDoc.MailFile(0)),".NS")-1)
' Ende Änderung 2 13.01.03
Else
FileFromNABList(FileCount%) = Ucase$(NABDoc.MailFile(0))
End If
FileCount%=FileCount%+1
Next
End Forall
'Compare the mail files found on the server to those in the Public address book. Exit if found and continue
Forall FileFromServer In FileFromServerList
Found = False
Print "Prüfe die Maildatei " + FileFromServer.FilePath
Forall FileFromNAB In FileFromNABList
If FileFromServer.FilePath = FileFromNAB Then
Found = True
Exit Forall
End If
End Forall
'If a mail file is not listed in the Public Address Book, flag it
If Found = False Then
Call uidoc.FieldAppendText ("MailFileName", FileFromServer.FilePath & Chr$(10))
Call uidoc.FieldAppendText ("MailFileOwner", FileFromServer.Owner & Chr$(10))
Call uidoc.FieldAppendText ("ServerName", FileFromServer.ServerName & Chr$(10))
End If
End Forall
Else
Messagebox("Kann das Adressbuch nicht öffnen :-(")
End If
End Sub