Manage Learn to apply best practices and optimize your operations.

Get names from nested NAB groups

A simple LotusScript agent using recursion can very easily explode groups to any depth.

I've seen many applications that make use of NAB groups to populate choice lists, etc. However, if groups are nested to any level, I challenge anyone to return a fully exploded list using simple @Functions. A simple LotusScript agent using recursion can very easily explode groups to any depth.

The key function in the code below is ExplodeIt(). The other code is included to make a working example. Try stepping through it with the debugger, and change GroupName$ to something meaningful for your environment. The end result is array PeopleNames(), sorted into alphabetical order, with any duplicates removed.

Note - I take no credit for function SortArray() which I got from this or a similar 'tips' database.

'Explode Group Name: 

Option Public

Dim PeopleNames()
Dim db As NotesDatabase
Dim NAB As NotesDatabase
Dim NABView As NotesView

Sub Initialize
     Dim s As New NotesSession
     Set db = s.currentdatabase
     Redim Preserve PeopleNames(0)
     Set NAB = New NotesDatabase( db.server , "NAMES.NSF")
     Set NABView = NAB.GetView( "Groups" )
     GroupName$ = "AnyGroup in NAB"
     Call ExplodeIt( GroupName$ )     
     Call SortArray( PeopleNames )
     Call FilterArray( PeopleNames )
End Sub

Function ExplodeIt( item )
     Dim GroupDoc As NotesDocument
     Set GroupDoc  = NABView.GetDocumentByKey( item , exact )
     If GroupDoc Is Nothing Then
          Call AddToList ( item )
          Forall item2 In GroupDoc.members
               Call ExplodeIt( item2 )
          End Forall
     End If
End Function
Function AddToList( item )
     PeopleNames(Ubound( PeopleNames) ) = item
     Redim  Preserve PeopleNames( Ubound(PeopleNames) + 1)
End Function
Sub SortArray(work)
     i% = -1
     Forall stringItem In work          
          i% = i% + 1
          minS$ = stringItem
          minJ% = i%
          For j% = i% To Ubound(work)
               If work(j%) < minS$ Then
                    minS$ = work(j%)
                    minJ% = j%
               End If
          If i% <> minJ% Then   'Last item, no need to exchange
               work(minJ%) = work(i%)
               work(i%) = minS$
          End If
     End Forall
End Sub

Function FilterArray( work )
     Dim tmparray()
     Dim counter%
     Dim lastvalue
     Dim curvalue
     lastvalue = ""
     Redim Preserve tmparray( 0 )
     For counter% = 0 To Ubound( work ) 
          curvalue = work( counter% )
          If curvalue <> lastvalue Then
               tmparray( Ubound( tmparray )) = curvalue
               Redim Preserve tmparray( Ubound(tmparray) + 1)
               lastvalue = curvalue
          End If
     ' tmparray will have one extra element so redim to remove it
     If Ubound(tmparray) > 0 Then
          Redim Preserve tmparray( Ubound( tmparray ) -1)
     End If
     Redim work(Ubound (tmparray))
     For counter% = 0 To Ubound(tmparray)
          work( counter%) = tmparray( counter% )
     FilterArray = work
End Function


Dig Deeper on Domino Resources - Part 7

  • Favorite iSeries cheat sheets

    Here you'll find a collection of valuable cheat sheets gathered from across the iSeries/ community. These cheat ...