Ajouter une Personne à un Groupe

[Michael DELIQUE]

Code : Tout sélectionner

Function GroupeAddMember(wDBNAB As NotesDatabase, wServer As String, wGroupe As String, wUserName As String, wnbCacheReset As Boolean, wnbAdminp As Boolean) As Boolean
   
   Dim Session As New NotesSession
   Dim AdminP As NotesAdministrationProcess
   Dim nmServer As NotesName
   Dim nmUser As NotesName
   Dim nmGroupe As NotesName
   Dim vwGroupe As NotesView
   Dim DocGroupe As NotesDocument
   Dim Item As NotesItem
   Dim NotesID As String
   
   
   On Error Goto ErreurHandle
   
   GroupeAddMember = 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 Trim(wServer) = "" Then
      Set nmServer = New NotesName(Session.CurrentDatabase.Server)
   Else
      Set nmServer = New NotesName(Trim(wServer))
   End If
   
   If wnbAdminP = True Then
      Set AdminP = Session.CreateAdministrationProcess(nmServer.Abbreviated)
      NotesID = AdminP.AddGroupMembers(nmGroupe.Canonical,nmUser.Canonical)
      Set AdminP = Nothing
      GroupeAddMember = True   
   Else      
      If wDBNAB Is Nothing Then
         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 Item Is Nothing Then
            Set Item = New NotesItem(DocGroupe,"Members",NAMES)
         End If
         If Item.Contains(nmUser.Canonical) = False Then
            If Item.Contains(nmUser.Abbreviated) = False Then
               If Item.Contains(nmUser.Common) = False Then
                  Call Item.AppendToTextList(nmUser.Canonical)
                  Call DocGroupe.ComputeWithForm(True,False)
                  Call DocGroupe.Save(True,False)
                  GroupeAddMember = True   
               End If
            End If
         End If
         Set Item = Nothing
         Set DocGroupe = Nothing
      End If   
      
      If wnbCacheReset = True Then
         If GroupeAddMember = True Then
            Call Session.SendConsoleCommand(nmServer.Canonical,  "show nlcache reset")
            Call Session.SendConsoleCommand(nmServer.Canonical,  "DBCache Flush")
         End If
      End If
   End If
   
   Set nmUser = Nothing
   Set nmGroupe = Nothing
   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 !"
   GroupeAddMember = False
   Exit Function   
End Function