Page 1 sur 1
Tous les groupes d'un utilisateur
Publié:
28 Avr 2010 à 10:03par Michael DELIQUE
- Code : Tout sélectionner
Function UserGroupe(wUser As String, wnbIsMember As Boolean,wnbIsAdmin As Boolean, wnbIsOwner As Boolean) As Variant
'renvoi la liste des groupe dans lesquel un utilsateur est présent
'Déclaration des Variables
Dim DBNAB As Notesdatabase
Dim lstGroupe List As String
Dim Doc As NotesDOcument
Dim collection As NotesDocumentCollection
Dim Selection As String
Dim nmUser As NotesName
Dim i As Long
On Error Goto ErreurHandle
If Trim(wUser)="" Then
Error 9999,"wUser is empty"
Exit Function
End If
Set DBNAB = DBOpenNAB("")
If DBNAB Is Nothing Then
Error 9999,"DBNAB is Nothing"
Exit Function
End If
Set nmUser = New NotesName(wUser)
Selection = ""
If wnbIsMember = True Then
Selection = "@contains(Members;"""+Cstr(nmUser.canonical)+""")"
End If
If wnbIsAdmin = True Then
If Trim(Selection) = "" Then
Selection = "@contains(LocalAdmin;"""+Cstr(nmUser.canonical)+""")"
Else
Selection = Selection+" | @contains(LocalAdmin;"""+Cstr(nmUser.canonical)+""")"
End If
End If
If wnbIsOwner = True Then
If Trim(Selection) = "" Then
Selection = "@contains(ListOwner;"""+Cstr(nmUser.canonical)+""")"
Else
Selection = Selection+" | @contains(ListOwner;"""+Cstr(nmUser.canonical)+""")"
End If
End If
If Trim(selection) = "" Then
Selection = {@contains(Members;"}+Cstr(nmUser.canonical)+{")}
End If
Selection = {@uppercase(Form) = "GROUP" & ( }+Selection+{ ) }
Set collection = DBNAB.Search(Selection,Nothing,0)
Selection = ""
Set nmUser = Nothing
If Not Collection Is Nothing Then
Set DBNAB = Nothing
Set UserGroupe = Nothing
Exit Function
Elseif Collection.count = 0 Then
Set collection = Nothing
Set DBNAB = Nothing
Set UserGroupe = Nothing
Exit Function
End If
i = -1
Set Doc = Collection.getFirstDocument
While Not Doc Is Nothing
If Trim(Doc.getitemvalue("Listname")(0))<>"" Then
i = i+1
Set nmUser = New NotesName(Doc.GetItemValue("Listname")(0))
lstGroupe(i) = nmUser.canonical
Set nmUser = Nothing
End If
Set Doc = Collection.getNextDocument(Doc)
Wend
Set collection = Nothing
Set nmUser = Nothing
Set DBNAB = Nothing
UserGroupe = lstGroupe
Erase lstGroupe
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 !"
Set collection = Nothing
Set nmUser = Nothing
Set DBNAB = Nothing
Erase lstGroupe
Set UserGroupe = Nothing
Exit Function
End Function