Tous les Membres d'un groupe

[Michael DELIQUE]

Code : Tout sélectionner

Public Function GroupeAllMembers(wGroupe As String, wDBNAB As NotesDatabase, wvwNAB As NotesView, wServer As String, ByVal wnbSousGroupe As Boolean, wnbUnique As Boolean) As Variant
      %REM renvois tous les membres d'un groupe
      si wSousGroupe = false renvois la liste des noms contenu dans la fiche du NAB
      si wSousGroupe =  true recherche dans les groupe déclaré comme membre le nom des utilisateurs
      si wUnique = true evite les doublons
   %end rem
         Dim lstNom List As String
         Dim lstNom2 List As String
         Dim DBNAB As NotesDatabase
         Dim vwNAB As NotesView      
         Dim Doc As NotesDocument
         Dim i As Integer
         Dim vrValue As Variant
         Dim vrMember As Variant
         Dim nmServer As NotesName
         Dim nmGroupe As NotesName
         Dim nmUser As NotesName
         
         On Error GoTo CatchError
         
         If Trim(wGroupe) = "" Then
            lstNom(0) = ""
            GroupeAllMembers = lstNom
            Exit Function
         End If
         
         If Session Is Nothing Or DB Is Nothing Then
            Set Session = New NotesSession
            Set DB = Session.CurrentDatabase
         End If
         
         If Trim(wServer) = "" Then      
            Set nmServer = New NotesName(DB.Server)
         Else      
            Set nmServer = New NotesName(Trim(wServer))
         End If
         
         REM connection au NAB
         If wDBNAB Is Nothing Then
            Set DBNAB = DBOpenNAB(nmServer.Canonical,True)            
            Set wDBNAB = DBNAB
         Else
            Set DBNAB = wDBNAB         
         End If   
         
         If DBNAB Is Nothing Then
            Error 9999,"Carnet d'adresse public inaccessible"
            lstNom(0) = ""
            GroupeAllMembers = lstNom
            Exit Function
         End If
         
         If Not wvwNAB Is Nothing Then
            If Trim(wvwNAB.Name) <> "($VIMGroups)" Then
               Set wvwNAB = Nothing
            End If
         End If
         
         If wvwNAB Is Nothing Then
            Set vwNAB = DBNAB.GetView("($VIMGroups)")
            Set wvwNAB = vwNAB   
         Else
            Set vwNAB = wvwNAB
         End If
         
         If vwNAB Is Nothing Then
            Error 9999,"View '($VIMGroups)' is Nothing"
            lstNom(0) = ""
            GroupeAllMembers = lstNom
            Exit Function
         End If
         
         REM recherche du document du groupe
         Set nmGroupe = New NotesName(Trim(wGroupe))
         Set Doc = vwNAB.GetDocumentByKey(nmGroupe.Abbreviated,True)
         Set nmGroupe = Nothing
         If doc Is Nothing Then
            lstNom(0) = ""
            GroupeAllMembers = lstNom
            Set vwNAB = Nothing
            Set DBNAB = Nothing
            Exit Function
         End If
         
         If wnbSousGroupe = False Then
            REM renvois juste les membre du groupe, pas de récursivité
            GroupeAllMembers = Doc.GetItemValue("Members")
            Set Doc = Nothing
            Set vwNAB = Nothing
            Set DBNAB = Nothing
            Exit Function
         Else
            REM recupere les noms
            i=-1
            vrMember = Doc.GetItemValue("Members")
            ForAll Nom In vrMember
               If Trim(CStr(Nom)) <> "" Then
                  Set nmUser = New NotesName(Trim(CStr(Nom)))
                  i=i+1
                  lstNom(i) = nmUser.Canonical
                  Set nmUser = Nothing
               End If
            End ForAll
            vrMember = Null
            Set Doc = Nothing
         End If
         
         i=-1
         REM recherche pour chaque nom si c'est un groupe ou pas
         ForAll Nom2 In lstNom
            Set nmGroupe = New NotesName(Trim(Nom2))
            Set Doc = vwNAB.GetDocumentByKey(nmGroupe.Abbreviated,True)
            If Doc Is Nothing Then
               i=i+1
               lstNom2(i) = CStr(Nom2)
            Else
               REM si c'est un groupe (le document existe) la fonction se rappel
               Set Doc = Nothing
               vrValue = GroupeAllMembers(nmGroupe.Canonical,DBNAB,vwNAB,nmServer.Canonical,True,wnbUnique)
               ForAll Nom3 In vrValue
                  If Trim(CStr(Nom3)) <> "" Then
                     i=i+1
                     lstNom2(i) = CStr(Nom3)
                  End If
               End ForAll
               vrValue = Null
            End If
            Set nmGroupe = Nothing
         End ForAll
         
         Erase lstNom
         
         REM retire les doublons si necessaire
         If wnbUnique = True Then
            ForAll Nom4 In lstNom2
               lstNom(Nom4) = Nom4
            End ForAll
            i=-1
            GroupeAllMembers = lstNom
         Else
            GroupeAllMembers = lstNom2
         End If
         
         i=0
         
         Set Doc = Nothing
         Set vwNAB = Nothing
         Set DBNAB = Nothing
         Erase lstNom
         Erase lstNom2
         
         Exit Function
CatchError:
         MsgBox "("+Cstr(GetThreadInfo (1))+" Call by "+Cstr(GetThreadInfo(10))+")"+Chr(10)+"Error " + CStr(Err) + " : "+Chr(10) + CStr(Error)+". "+Chr(10)+"Line # "+Cstr(Erl),16," ERROR !"
         Erase lstNom
         lstNom(0) = ""
         GroupeAllMembers = lstNom
         Resume Next
         Exit Function
End Function