Tous les groupes d'un utilisateur

[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