Page 1 sur 1
est Membre du Groupe

Publié:
26 Oct 2010 à 16:23
par 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