- Code : Tout sélectionner
Declaration
Dim acl As NotesACL
Dim i As Integer
Dim Entry As NotesACLEntry
Dim nmEntry As NotesName
Dim TypeEntry As String
Dim TypeAccess As String
Dim Role As String
Dim Info As String
Dim lstValue List As String
- Code : Tout sélectionner
Sub Initialize
Dim dbSource As NotesDatabase
Dim sourceServer As Variant
Dim sourcePath As Variant
Dim LstArchServer As Variant
sourceServer = "SerVeur" Ou à passer en paramètre
sourcePath ="Base" Ou à passer en paramètre
Set dbSource=New NotesDatabase (sourceServer,sourcePath)
Call RemoveACL(dbSource)
End Sub
- Code : Tout sélectionner
Function RemoveACL(dbSource As NotesDatabase)
'Supprime toutes les entrées de l'ACL d'une Base
'*****************************************************
Dim session As New NotesSession
Dim entryTemp
On Error Goto ErreurHandle
Set acl = dbSource.ACL
If acl Is Nothing Then
Error 9999,"ACL inaccessible sur la base cible"
Exit Function
End If
I = -1
Set Entry = Acl.getfirstEntry
While Not Entry Is Nothing
i = i+1
Set nmEntry = New NotesName(Entry.Name)
lstValue(i) = nmEntry.abbreviated+"("+TypeEntry+") : "+TypeAccess+Role+Info
If Entry.Name <> "-Default-" Then
Set entrytemp = entry
Else
Set entryTemp = Nothing
End If
Set nmEntry = Nothing
Set Entry = Acl.getNextEntry(Entry)
If Not entrytemp Is Nothing Then
Call entrytemp.remove
End If
Wend
Set entry = acl.CreateACLEntry ( "NOTES-CONSULTANT", ACLLEVEL_MANAGER )
Call acl.Save
Erase lstValue
Set DBSource = Nothing
Set acl = Nothing
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Exit Function
End Function
* on peut simplifié un peu en virant les propriétés "TypeAccess+Role+Info" mais bon, ça mange pas de pain et peut s'avérer bien pratique
Rendons à jules ce qui appartient à Cesar :
Merci à Michael, car tout vient de sa super fonction :
http://forum.dominoarea.org/une-image-de-la-lca-t14551.html
