Page 1 sur 1
Liste des Utilisateurs de la LCA en fonction d'un rôle
Publié:
15 Avr 2010 à 10:30par Michael DELIQUE
- Code : Tout sélectionner
Function ACLAccesRole(wDB As NotesDatabase,wRole As String) As Variant
'renvois la liste de tous les utilisateurs ou groupe ayant le role passé en paramètre
Dim Session As New NotesSession
Dim DBCible As NotesDatabase
Dim ACL As NotesACL
Dim ACLEntry As NotesACLEntry
Dim lstValue List As String
Dim nbUser As Integer
Dim nmUser As NotesName
Dim Role As String
On Error Goto ErreurHandle
ACLAccesRole = Null
If Trim(wRole) = "" Then
Exit Function
End If
If Left(Trim(wRole),1) = "[" Then
Role = wRole
Else
Role = "["+wRole
End If
If Right(Trim(wRole),1) <> "]" Then
Role = Role+"]"
End If
If wDB Is Nothing Then
Set DBCible = Session.CurrentDatabase
Else
Set DBCible = wDB
End If
Set ACL = DBCible.ACL
If ACL Is Nothing Then
Error 9999,"ACL is Nothing"
Exit Function
End If
nbUser = 0
Set ACLEntry = ACL.getfirstEntry
While Not ACLEntry Is Nothing
If testVariant(ACLEntry.Roles) = True Then
Forall ValueRole In ACLEntry.Roles
If Trim(Cstr(ValueRole)) <> "" Then
If ACLEntry.IsGroup =True Or ACLEntry.IsPerson = True Then
If Ucase(Trim(Role)) = Ucase(Trim(Cstr(ValueRole))) Then
Set nmUser = New NotesName(ACLEntry.Name)
lstValue(nbUser) = Cstr(nmUser.Canonical)
Set nmUser = Nothing
nbUser = nbUser+1
End If
End If
End If
End Forall
End If
Set ACLEntry = ACL.getNextEntry(ACLEntry)
Wend
Set ACL = Nothing
Set DBCible = Nothing
If nbUser > 0 Then
ACLAccesRole = lstValue
Erase lstValue
End If
Exit Function
ErreurHandle:
Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
ACLAccesRole = Null
Exit Function
End Function