Page 1 sur 1
Tous les Membres d'un groupe
Publié:
23 Mai 2013 à 09:36par 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