Function AddUserToGroup (username As String , basegroup As String) As Boolean
Dim ServerNum As String
Dim saveGroupMainDoc As Integer
'Get group view
Set view = dbreggroup .GetView("Groups")
Set docGroup = view.Getdocumentbykey(basegroup)
If (docGroup Is Nothing) Then
Set docGroup = dbreggroup.CreateDocument
Call docGroup.ReplaceItemValue("Form", "Group")
Call docGroup.ReplaceItemValue("ListName", basegroup)
Call docGroup.ReplaceItemValue("Members", basegroup & "#1")
Call docGroup.ReplaceItemValue("GroupType", "0")
Call docGroup.ReplaceItemValue("ListDescription", "Do not edit this group manually, it is updated via an agent.")
Call docGroup.ComputeWithForm( False, False )
Call docGroup.Save(False, False)
End If
'Adds a user to a group.
Dim groupMainMembers As NotesItem
Dim groupMainName As String
Set groupMainMembers = docGroup.GetFirstItem( "Members" )
groupMainName = docGroup.GetItemValue("ListName")(0)
' Find last subgroup entry in the members list
Dim subGroup As String
subGroup = ""
Forall s In groupMainMembers.Values
If Left$( s, Len( groupMainName ) ) = groupMainName Then subGroup = s
End Forall
' Open the subgroup, and keep trying until we find one with room
Dim groupNum As Integer
groupNum = 0
' Which subgroup was the last one
If subGroup <> "" Then
groupNum = Val( Right( subGroup, Len( subGroup ) - Len( groupMainName ) - 1 ) )
Else
groupNum = 1
subGroup = groupMainName & "#1"
End If
Dim groupSubDoc As NotesDocument
Do
Set groupSubDoc = view.GetDocumentByKey( subGroup )
If groupSubDoc Is Nothing Then
Set groupSubDoc = dbreggroup.CreateDocument
Call groupSubDoc.ReplaceItemValue("Form", "Group")
Call groupSubDoc.ReplaceItemValue("ListName", subGroup)
Call groupSubDoc.ReplaceItemValue("GroupType", "0")
Call groupSubDoc.ComputeWithForm( False, False )
' Add it to the main group if needed
If Not groupMainMembers.Contains( subGroup ) Then
Call groupMainMembers.AppendToTextList( subGroup )
saveGroupMainDoc = True
End If
End If
' See if the subgroup still has room, if so, we've found our subgroup
Dim groupSubMembers As NotesItem
Set groupSubMembers = groupSubDoc.GetFirstItem("Members")
If groupSubMembers Is Nothing Then ' notes administrator seems to delete the item if nomore elements
Call groupSubDoc.ReplaceItemValue("Members","")
Else
If groupSubMembers.ValueLength < 14000 Then Exit Do
' If no room, try the next one
groupNum = groupNum+1
subGroup = groupMainName & "#" & groupNum
End If
Loop
'add the user to the subgroup
Call groupSubMembers.AppendtoTextList(username)
Call groupSubDoc.Save( False, True )
'Save main group if we just added a subgroup name
If saveGroupMainDoc = True Then Call docGroup.Save(True,False)
AddUserToGroup =True
End Function
