Falls es mal einer braucht, hier ist ein Code.
Ich habe den Code komplett im Designer 8.0.1 direkt unter "Initialize" eingegeben. Der Designer splittet ihn selbstständig auf.
Zwei Tests liefen erfolgreich, der Zugriffslevel der Mailfile Eigentümer wurde von xxx auf Editor gesetzt.
Sub Initialize
Dim session As Notessession
Dim db As NotesDatabase
Dim doc As NotesDocument
Dim dbmail As NotesDatabase
Dim owner As Variant
Dim strmailfile As String
Dim cserver As String
Dim dbdir As NotesDatabase
Dim docu As NotesDocument
Dim searchString As String
Dim cu As Integer
Dim dcu As NotesDocumentCollection
Dim strmailfiles As String
Dim strmailserver As String
Dim x As Integer
Set session = New NotesSession
Set db = session.CurrentDatabase
cserver = db.Server 'Get the servername of the server where this database is located.
Set dbdir = session.GetDatabase(cserver ,"names.nsf") 'Use the Domino Directory (NAB) on the current server.
searchString = |Form = "Person"|
Set dcu = dbdir.Search(searchString, Nothing, 0)
cu = dcu.Count
Redim varEntries(cu, 2) 'Update the array varEntries with the right amount of records.
Set docu = dcu.GetFirstDocument
While Not (docu Is Nothing) 'Populate the array with data from the person documents.
varEntries(x,0) = docu.mailfile(0)
strmailfiles = strmailfiles + |"| + Strright(docu.mailfile(0), "\") + |":|
varEntries(x,1) = docu.FullName
varEntries(x,2) = docu.mailserver(0)
Set docu = dcu.GetNextDocument(docu)
x = x + 1
Wend
strmailfiles = Left(strmailfiles,Len(strmailfiles)-1)
For x = 0 To cu-1
strmailfile = varEntries(x,0)
strmailserver = varEntries(x,2)
owner = varEntries(x,1)
If owner(0) <> session.UserName Then
Set dbmail = session.GetDatabase(strmailserver, strmailfile)
Call CheckAcl(dbmail, owner(0))
End If
Next
End Sub
Sub CheckAcl(dbmail As NotesDatabase, strusr As Variant)
Dim acl As NotesACL
Dim entry As NotesACLEntry
If Not (dbmail.IsOpen) Then
Messagebox "Could not open mailfile for " & strusr,,"Warning"
Exit Sub
End If
Set acl = dbmail.ACL
Set entry = acl.GetEntry(strusr)
If entry Is Nothing Then
Messagebox "No acl entry for " & strusr & " present in " & dbmail.Title,,"Warning"
Else
entry.UserType = ACLTYPE_PERSON
entry.Level = ACLLEVEL_EDITOR
entry.CanDeleteDocuments = True
entry.CanCreateLSOrJavaAgent = True
entry.CanReplicateOrCopyDocuments = True
acl.AdministrationServer = "yourserver/here"
Call acl.Save
End If
End Sub
