Tous les membres d'un groupe
Publié: 11 Nov 2005 à 01:39fonction récursive qui renvois pour un groupe la liste des utilisateurs.
- Code : Tout sélectionner
Function AllGroupeMembers(wGroupe As String, wdbCAP As NotesDatabase, wvwCAP As NotesView, Byval wSousGroupe As Integer, wUnique As Integer) As Variant
'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
'Déclaration Variable
Dim lstNom List As String
Dim lstNom2 List As String
Dim DBCAP As Notesdatabase
Dim vwGroupe As NotesView '($VIMGroups)
Dim Doc As NotesDocument
Dim i As Integer
Dim vrValue As Variant
On Error Goto ErreurAllGroupeMembers
If Trim(wGroupe) = "" Then
lstNom(0) = ""
AllGroupeMembers = lstNom
Exit Function
End If
'connection au NAB
If wDBCAP Is Nothing Then
Set DBCAP = DBCAPublic
If DBCAP Is Nothing Then
Error 9999,"Carnet d'adresse public inaccessible"
lstNom(0) = ""
AllGroupeMembers = lstNom
Exit Function
End If
'connexion à la vue de recherche et
Set vwGroupe = DBCAP.getview("($VIMGroups)")
Else
Set DBCAP = wDBCAP
If wvwCAP Is Nothing Then
'connexion à la vue de recherche
Set vwGroupe = DBCAP.getview("($VIMGroups)")
Else
Set vwGroupe = wvwCAP
End If
End If
'recherche du document du groupe
Set Doc = vwGroupe.GetDocumentByKey(wGroupe,True)
If doc Is Nothing Then
lstNom(0) = ""
AllGroupeMembers = lstNom
Set vwGroupe = Nothing
Set DBCAP = Nothing
Exit Function
End If
If wSousGroupe = False Then
' renvois juste les membre du groupe, pas de récursivité
AllGroupeMembers = Doc.GetItemValue("Members")
Set Doc = Nothing
Set vwGroupe = Nothing
Set DBCAP = Nothing
Exit Function
Else
'recupere les noms
i=-1
Forall Nom In Doc.GetItemValue("Members")
i=i+1
lstNom(i) = Cstr(Nom)
End Forall
Set Doc = Nothing
End If
i=-1
'recherche pour chaque nom si c'est un groupe ou pas
Forall Nom2 In lstNom
Set Doc = vwGroupe.GetDocumentByKey(Nom2,True)
If Doc Is Nothing Then
i=i+1
lstNom2(i) = Cstr(Nom2)
Else
'si c'est un groupe (le document existe) la fonction se rappel
Set Doc = Nothing
vrValue = AllGroupeMembers(Nom2,DBCAP,vwGroupe,True,wUnique)
Forall Nom3 In vrValue
i=i+1
lstNom2(i) = Cstr(Nom3)
End Forall
vrValue = Null
End If
End Forall
Erase lstNom
'retire les doublons si necessaire
If wUnique = True Then
Forall Nom4 In lstNom2
lstNom(Nom4) = Nom4
End Forall
i=-1
Erase lstNom2
Forall Nom5 In lstNom
i=i+1
lstNom2(i) = Nom5
End Forall
End If
i=0
AllGroupeMembers = lstNom2
Set Doc = Nothing
Set vwGroupe = Nothing
Set DBCAP = Nothing
Erase lstNom
Erase lstNom2
Exit Function
ErreurAllGroupeMembers:
Msgbox "(AllGroupeMembers)"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Erase lstNom
lstNom(0) = ""
AllGroupeMembers = lstNom
Resume Next
Exit Function
End Function
- Code : Tout sélectionner
Function DBCAPublic As Notesdatabase
'renvois un variable de type NotesDatabase contenant le carnet d'adresse public
'Déclaration des Variables
Dim dbCAP As NotesDatabase
Dim nbCAPopen As Integer
On Error Goto ErreurDBCAPublic
If session Is Nothing Then
Set session = New notesSession
End If
Forall ValueAB In session.AddressBooks
If ValueAB.IsPublicAddressBook Then
Set dbCAP = ValueAB
Exit Forall
End If
End Forall
nbCAPopen = DBExists_LS(dbCAP )
If nbCAPopen = False Then
nbCAPopen = dbCAP.Open("","")
End If
If nbCAPopen = False Then
' Error 9999, "Le Carnet d'Adresse Public est introuvable."
Set DBCAPublic = Nothing
Else
Set DBCAPublic = dbCAP
End If
Set dbCAP = Nothing
Exit Function
ErreurDBCAPublic:
Msgbox "(DBCAPublic)"+Chr(10)+"Erreur " + Str(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
Set dbCAP = Nothing
Set DBCAPublic = Nothing
Exit Function
End Function