Page 1 sur 1
Créer un Groupe
Publié:
27 Oct 2010 à 12:45par Michael DELIQUE
- Code : Tout sélectionner
Function GroupeCreate(wDBNAB As NotesDatabase, wServer As String, wGroupe As String, wGroupeType As String,wvrMember As Variant,wFormat As String,wListOwner As String, wLocalAdmin As String,wnbCacheReset As Boolean) As NotesDocument
Dim Session As New NotesSession
Dim nmGroupe As NotesName
Dim nmServer As NotesName
Dim DocGroupe As NotesDocument
Dim nbCanonical As Boolean
Dim nbGroupeType As Integer
Dim item As NotesItem
On Error Goto ErreurHandle
Set GroupeCreate = Nothing
If Trim(wGroupe) = "" Then
Error 9999,"wGroupe isEmpty"
End If
Select Case Ucase(Trim(wGroupeType))
Case "0","M","MULTI","MULTIFONCTION"
nbGroupeType =0
Case "2","LCA","ACL","LCA ONLY","ACL UNIQUEMENT"
nbGroupeType = 2
Case "1","MESSAGERIE","MAIL","MAIL ONLY","MESSAGERIE UNIQUEMENT"
nbGroupeType = 1
Case "4","S","SERVER","SERVERS","SERVEUR","SERVEURS","SERVERS ONLY","SERVEURS UNIQUEMENT"
nbGroupeType = 4
Case "3","I","INTRUS"
nbGroupeType = 3
Case Else
nbGroupeType = 0
End Select
Select Case Ucase(Trim(wFormat))
Case ""
Error 9999,"wFormat isEmpty"
Exit Function
Case "ABBREVIATED","ABBREVIATE","ABB","AB","A"
nbCanonical = False
Case "CANONICAL","CANONICALIZE","CAN","CANON","CA","C"
nbCanonical = True
Case Else
Error 9999,"Bad wFormat : "+wFormat
Exit Function
End Select
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)
Set nmGroupe = Nothing
Else
Set nmServer = New NotesName(wDBNAB.Server)
End If
If wDBNAB Is Nothing Then
Error 9999,"wDBNAB is Nothing"
Exit Function
End If
If GroupeIsValide(wDBNAB,wDBNAB.Server,wGroupe) = True Then
Set nmGroupe = Nothing
Set DocGroupe = Nothing
Error 9999,"this group already exists : "+Trim(wGroupe)
Exit Function
End If
Set DocGroupe = wDBNAB.CreateDocument
Call DocGroupe.ReplaceItemValue("Form","Group")
Call DocGroupe.ReplaceItemValue("ListName",nmGroupe.Abbreviated)
Call DocGroupe.ReplaceItemValue("GroupType",nbGroupeType)
Set item = New NotesItem(DocGroupe,"ListOwner","",AUTHORS)
Select Case Trim(wListOwner)
Case "" 'on fait rien
Case "*"
Call item.AppendToTextList("*")
Case Else
Set nmGroupe = New NotesName( Trim(wListOwner))
Call item.AppendToTextList(nmGroupe.Canonical)
Set nmGroupe = Nothing
End Select
Set item = Nothing
Set item = New NotesItem(DocGroupe,"LocalAdmin","",AUTHORS)
Select Case Trim(wLocalAdmin)
Case "" 'on fait rien
Case "*"
Call item.AppendToTextList("*")
Case Else
Set nmGroupe = New NotesName( Trim(wLocalAdmin))
Call item.AppendToTextList(nmGroupe.Canonical)
Set nmGroupe = Nothing
End Select
Set item = Nothing
Set Item = New NotesItem(DocGroupe,"Members","",NAMES)
If Isarray(wvrMember) Or Islist(wvrMember) Then
Forall value In wvrMember
If Trim(Cstr(value)) <> "" Then
Set nmGroupe = New NotesName(Trim(Cstr(wvrMember)))
If nbCanonical = True Then
Call Item.AppendToTextList(nmGroupe.Canonical)
Else
Call Item.AppendToTextList(nmGroupe.Abbreviated)
End If
Set nmGroupe = Nothing
End If
End Forall
Elseif Ucase(Typename(wvrMember)) = "STRING" Then
Set nmGroupe = New NotesName(Trim(Cstr(wvrMember)))
If nbCanonical = True Then
Call Item.AppendToTextList(nmGroupe.Canonical)
Else
Call Item.AppendToTextList(nmGroupe.Abbreviated)
End If
Set nmGroupe = Nothing
End If
Set Item = Nothing
Call DocGroupe.ComputeWithForm(True,False)
Call DocGroupe.Save(True,False)
Set GroupeCreate = DocGroupe
Set DocGroupe = Nothing
If wnbCacheReset = True Then
Call Session.SendConsoleCommand(nmServer.Canonical, "show nlcache reset")
Call Session.SendConsoleCommand(nmServer.Canonical, "DBCache Flush")
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 !"
Set GroupeCreate = Nothing
Exit Function
End Function