est Membre du Groupe

[Michael DELIQUE]

Code : Tout sélectionner

Function GroupeIsMember(wDBNAB As NotesDatabase,wServer As String,wGroupe As String,wUserName As String) As Boolean
   
      'Déclaration Variable   
   Dim Session As New NotesSession   
   Dim vwGroupe As NotesView
   Dim nmGroupe As NotesName
   Dim nmUser As NotesName
   Dim DocGroupe As NotesDocument
   Dim item As NotesItem
   
   On Error Goto ErreurHandle
   GroupeIsMember = False
   
   If Trim(wUserName) = "" Then
      Error 9999,"wUserName is empty"
      Exit Function
   End If
   
   If Trim(wGroupe) = "" Then
      Error 9999,"wGroupe is Empty"
      Exit Function
   End If
   
   If wDBNAB Is Nothing Then      
      If Trim(wServer) = "" Then
         Set nmUser = New NotesName(Session.CurrentDatabase.Server)
      Else
         Set nmUser = New NotesName(Trim(wServer))
      End If   
      Set wDBNAB = DBOpenNAB(nmUser.Abbreviated)
      Set nmUser = Nothing
   End If
   
   If wDBNAB Is Nothing Then
      Error 9999,"wDBNAB is Nothing"
      Exit Function
   End If
   
   Set vwGroupe = wDBNAB.GetView("($VIMGroups)")
   If vwGroupe Is Nothing Then
      Error 9999,"($VIMGroups) Not found"
      Exit Function
   End If
   
   Set nmGroupe = New NotesName(Trim(wGroupe))
   Set nmUser = New NotesName(Trim(wUserName))
   
   Set DocGroupe = vwGroupe.GetDocumentByKey(Cstr(nmGroupe.Canonical),True)
   
   If DocGroupe Is Nothing Then
      Set DocGroupe = vwGroupe.GetDocumentByKey(Cstr(nmGroupe.Abbreviated),True)
   End If   
   Set nmGroupe = Nothing
   Set vwGroupe = Nothing
   
   If Not DocGroupe Is Nothing Then
      Set Item = DocGroupe.GetFirstItem("Members")
      If Not item Is Nothing Then
         If Item.Contains(nmUser.Canonical) = True Then
            GroupeIsMember = True
         Elseif Item.Contains(nmUser.Abbreviated) = True Then
            GroupeIsMember = True
         End If
         Set item = Nothing
      End If
      Set DocGroupe = Nothing
   End If   
   
   Set nmGroupe = Nothing
   Set nmUser = Nothing
   
   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 !"
   GroupeIsMember = False
   Exit Function
End Function