Retirer une Personne d'un groupe

[Michael DELIQUE]

Code : Tout sélectionner

Function GroupeRemoveMember(wDBNAB As NotesDatabase, wServer As String, wGroupe As String, wUserName As String, wnbCacheReset As Boolean) As Boolean
   
   Dim Session As New NotesSession
   Dim nmServer As NotesName
   Dim nmUser As NotesName
   Dim nmUser2 As NotesName
   Dim nmGroupe As NotesName
   Dim vwGroupe As NotesView
   Dim DocGroupe As NotesDocument
   Dim Item As NotesItem
   Dim vrValue As Variant
   
   On Error Goto ErreurHandle
   
   GroupeRemoveMember = False
   
   If Trim(wGroupe) = "" Then
      Error 9999,"wGroupe isEmpty"
   Else
      Set nmGroupe = New NotesName(Trim(wGroupe))
   End If
   If Trim(wUSerName) = "" Then
      Error 9999,"wUserName isEmpty"
   Else
      Set nmUser = New NotesName(Trim(wUserName))
   End If
   
   If wDBNAB Is Nothing Then      
      If Trim(wServer) = "" Then
         Set nmServer = New NotesName(Session.CurrentDatabase.Server)
      Else
         Set nmServer = New NotesName(Trim(wServer))
      End If   
      Set wDBNAB = DBOpenNAB(nmServer.Abbreviated)
   Else
      Set nmServer = New NotesName(wDBNAB.Server)
   End If
   
   If wDBNAB Is Nothing Then
      Error 9999,"wDBNAB is Nothing"
      Exit Function
   End If
   Set vwGroupe = wDBNAB.GetView("($Groups)")
   If vwGroupe Is Nothing Then
      Error 9999,"vwGroupe '($Groups)' is Nothing"
      Exit Function
   End If
   Call vwGroupe.Refresh
   Set DocGroupe = vwGroupe.GetDocumentByKey(nmGroupe.Abbreviated,True)
   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 Or Item.Contains(nmUser.Abbreviated) = True Or Item.Contains(nmUser.Common) = True Then
            vrValue = Item.Values
            Item.Values = Null
            If Isarray(vrValue) =True Then
               If Isempty(vrValue) = False Then
                  Forall value In vrValue
                     If Trim(Cstr(value)) <> "" Then
                        Set nmUser2 = New NotesName(Trim(Cstr(value)))
                        If nmUser2.Canonical = nmUser.Canonical Then
                           GroupeRemoveMember = True
                        Else   
                           Call Item.AppendToTextList(nmUser2.Canonical)
                        End If                        
                        Set nmUser2 = Nothing
                     End If
                  End Forall
               End If
               If GroupeRemoveMember = True Then
                  Call DocGroupe.ComputeWithForm(True,False)
                  Call DocGroupe.Save(True,False)
               End If
               vrValue = Null
            End If
         End If
         Set Item = Nothing
      End If
      
      Set DocGroupe = Nothing
   End If   
   
   Set nmUser = Nothing
   Set nmGroupe = Nothing
   
   If wnbCacheReset = True Then
      If GroupeRemoveMember = True Then
         Call Session.SendConsoleCommand(nmServer.Canonical,  "show nlcache reset")
         Call Session.SendConsoleCommand(nmServer.Canonical,  "DBCache Flush")
      End If
   End If
   
   Set nmServer = Nothing
   
   Exit Function
ErreurHandle:
   Msgbox "("+Cstr(Getthreadinfo (1))+" Call by "+Cstr(Getthreadinfo(10))+")"+Chr(10)+"Erreur " + Cstr(Err) + " : "+Chr(10) + Cstr(Error)+". "+Chr(10)+"Ligne N° "+Cstr(Erl),16," ERREUR !"
   GroupeRemoveMember = False
   Exit Function   
End Function