Page 1 sur 1
Renomer un groupe
Publié:
27 Oct 2010 à 12:43par Michael DELIQUE
- Code : Tout sélectionner
Function GroupeRename(wDBNAB As NotesDatabase, wServer As String, wGroupe As String, wNewGroupe As String, wnbCacheReset As Boolean) As Boolean
Dim Session As New NotesSession
Dim nmGroupe As NotesName
Dim nmServer As NotesName
Dim nmNewGroupe As NotesName
Dim vwGroupe As NotesView
Dim DocGroupe As NotesDocument
On Error Goto ErreurHandle
GroupeRename = False
If Trim(wGroupe) = "" Then
Error 9999,"wGroupe isEmpty"
End If
If Trim(wNewGroupe) = "" Then
Error 9999,"wNewGroupe isEmpty"
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 nmNewGroupe = New NotesName(Trim(wNewGroupe))
Set DocGroupe = vwGroupe.GetDocumentByKey(nmNewGroupe.Abbreviated,True)
If Not DocGroupe Is Nothing Then
Set vwGroupe = Nothing
Set nmNewGroupe = Nothing
Set DocGroupe = Nothing
Error 9999,"this group already exists : "+Trim(wNewGroupe)
Exit Function
End If
Set nmGroupe = New NotesName(Trim(wGroupe))
Set DocGroupe = vwGroupe.GetDocumentByKey(nmGroupe.Abbreviated,True)
Set nmGroupe = Nothing
Set vwGroupe = Nothing
If Not DocGroupe Is Nothing Then
Call DocGroupe.ReplaceItemValue("ListName",nmGroupe.Canonical)
Call DocGroupe.ComputeWithForm(True,False)
Call DocGroupe.Save(True,False)
GroupeRename = True
Set DocGroupe = Nothing
End If
Set nmNewGroupe = Nothing
If wnbCacheReset = True Then
If GroupeRename = 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 !"
GroupeRename = False
Exit Function
End Function