Manage Learn to apply best practices and optimize your operations.

Retrieve address book group members & info

This tip describes retrieving address book group members and information about thier mailservers.

Use this code in a button to populate a dropdown with a list of all groups in the Address Book (names.nsf). You will then receive an email with a list of all group members (including those in nested groups) along with their Mail Server.

We use this in a multi-server environment to know which servers need replicas of specific databases. The ACL Group is created and saved with the desired members and then the button can be used to know where the database should be replicated.


Sub Click(Source As Button)
 
 On Error Goto errorhandler
 
 Dim session As New NotesSession
 Dim ws As New NotesUIWorkspace
 Dim uidoc As NotesUIDocument
 Dim view As NotesView
 Dim doc As NotesDocument
 Dim db As New NotesDatabase("", "")
 Dim db2 As notesdatabase
 Set db2 = session.currentdatabase
 Dim CurrentServer As String
 Dim doc2 As New notesdocument(db2)
 Dim rs1 As NotesRichTextStyle
 Dim rs2 As NotesRichTextStyle
 
 Dim maildoc As New NotesDocument ( db2 )
 Dim rtitem As New NotesRichTextItem ( maildoc, "Body" ) 
 
 Dim rtpStyle As NotesRichTextParagraphStyle
 Set rtpStyle = session.CreateRichTextParagraphStyle
 Call rtpStyle.SetTab(4500, 0)
 Call rtpStyle.SetTab(8500, 0)
 Call rtitem.AppendParagraphStyle(rtpStyle)
 
 Dim Response As String
 
 BoxTitle="ACL Group"
 BoxPrompt = "Please select the ACL Group."
 
 ShortStr$ = | @Name([CN]; "|+ session.CurrentDatabase.Server +|")|
 ServerShort = Evaluate(ShortStr$)
 CurrentServer = ServerShort(0)
 
 If session.CurrentDatabase.Server <> "" Then
  Call db.Open( session.CurrentDatabase.Server, "names.nsf" )
  dbcmd = |@Trim(@Unique(@DbColumn("" ; "| & CurrentServer & |" : "names.nsf" ; "Groups";2)))|
  
 Elseif ( Not ( db.Open( "", "pdnames.nsf" ) ) ) Then
  Messagebox ("You must either create a Local Replica of the Address Book or go connect to a server.")
  Exit Sub
 Else
  Call db.Open( session.CurrentDatabase.Server, "names.nsf" )
  dbcmd = |@Trim(@Unique(@DbColumn("" ; | & CurrentServer & | : "names.nsf" ; "Groups";2)))|
 End If
 
 Groups = Evaluate(dbcmd)
 
 Response = ws.Prompt(PROMPT_OKCANCELLIST, BoxTitle, BoxPrompt, "", Groups) 
 
 If Response = "" Then Exit Sub
 
 maildoc.Form = "Memo"
 maildoc.SendTo = Session.username
 maildoc.Subject = "Members and Home Servers for: " & Response
 Set rs1 = session.CreateRichTextStyle
 rs1.FontSize = 8
 rs1.Bold = True
 rs1.Underline = False
 Set rs2 = session.CreateRichTextStyle
 rs2.FontSize = 8
 rs2.Bold = False
 rs2.Underline = False
 
 Call FindMemberServer(Response, db, maildoc, rtitem, rs1, rs2, session)
 
 Call maildoc.Send ( False ) 
 
 Exit Sub
 
ErrorHandler:
 Set memodoc = New NotesDocument(db2)
 Dim recipients As String
 recipients = "Bryce Berry"     
 memodoc.form = "Memo"
 memodoc.subject = "Group Members Agent"
 msg = "Error #" & Format$(Err) & " at line " & Format$(Erl) & ": " & Error$
 memodoc.body = msg
 Call memodoc.Send(False, recipients)          
 
End Sub



Sub FindMemberServer(Response As String, db As NotesDatabase, maildoc As NotesDocument, rtitem As NotesRichTextItem, rs1 As NotesRichTextStyle, rs2 As NotesRichTextStyle, session As NotesSession)
 On Error Goto errorhandler
 
 Dim view As NotesView
 Dim doc2 As NotesDocument
 Dim HomeServer As String
 
 Set view = db.GetView( "($NamesFieldLookup)" )
 Set doc = view.GetDocumentByKey( Response )
 
 If doc Is Nothing Then
  Call rtitem.AppendStyle(rs1)
  Call rtitem.AppendText ( Response )
  Call rtitem.AddTab( 1 )
  Call rtitem.AppendStyle(rs2)
  Call rtitem.AppendText ( "This Group can not be found." )
  Call rtitem.AddNewLine( 1 )
  
 Else
  
  TotalListNum = Evaluate("@Elements(Members)", doc)
  
  If TotalListNum(0) = 0 Then
   Call rtitem.AppendStyle(rs1)
   Call rtitem.AppendText ( Response )
   Call rtitem.AddTab( 1 )
   Call rtitem.AppendStyle(rs2)
   Call rtitem.AppendText ( "This Group does not have any members." )
   Call rtitem.AddNewLine( 1 )
   Exit Sub
  End If
  
  For i = 1 To TotalListNum(0)
   MemberFull = Evaluate("@Subset(@Subset(Members; " & i & "); -1)", doc)
   ShortStr1$ = | @Name([Abbreviate]; "|+ MemberFull(0) +|")|
   ShortStr2$ = | @Name([CN]; "|+ MemberFull(0) +|")|
   MemberShort1 = Evaluate(ShortStr1$)
   MemberShort2 = Evaluate(ShortStr2$)
   
   Set doc2 = view.GetDocumentByKey( MemberShort1(0)  )
   
   If doc2 Is Nothing Then 
    
    Call rtitem.AppendStyle(rs1)
    Call rtitem.AppendText ( MemberShort2(0) )
    Call rtitem.AddTab( 1 )
    Call rtitem.AppendStyle(rs2)
    Call rtitem.AppendText ( MemberShort1(0) )
    Call rtitem.AddTab( 1 )
    Call rtitem.AppendText ( "Can't be found." )
    Call rtitem.AddNewLine( 1 )
    
   Else
    Select Case doc2.Form(0)
    Case "Person"
     HomeServer = doc2.MailServer(0)
     If HomeServer = "" Then
      HomeServer = "No Mail Server Specified"
     Else
      ShortStr$ = | @Name([CN]; "|+ HomeServer +|")|
      ServerShort = Evaluate(ShortStr$)
      HomeServer = ServerShort(0)
     End If
     
     Call rtitem.AppendStyle(rs1)
     Call rtitem.AppendText ( MemberShort2(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendStyle(rs2)
     Call rtitem.AppendText ( MemberShort1(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendText ( HomeServer )
     Call rtitem.AppendDocLink(doc2, "Person Doc")
     Call rtitem.AddNewLine( 1 )
     
    Case "Group"
     Call rtitem.AppendStyle(rs1)
     Call rtitem.AppendText ( MemberShort2(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendStyle(rs2)
     Call rtitem.AppendText ( MemberShort1(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendText ( "Nested group." )
     Call rtitem.AppendDocLink(doc2, "Group Doc")
     Call rtitem.AddNewLine( 1 )
     Call FindMemberServer(MemberShort1(0), db, maildoc, rtitem, rs1, rs2, session)
     
    Case "Server"
     Call rtitem.AppendStyle(rs1)
     Call rtitem.AppendText ( MemberShort2(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendStyle(rs2)
     Call rtitem.AppendText ( MemberShort1(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendText ( "Server Doc" )
     Call rtitem.AppendDocLink(doc2, "Server Doc")
     Call rtitem.AddNewLine( 1 )
     
    Case Else
     Call rtitem.AppendStyle(rs1)
     Call rtitem.AppendText ( MemberShort2(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendStyle(rs2)
     Call rtitem.AppendText ( MemberShort1(0) )
     Call rtitem.AddTab( 1 )
     Call rtitem.AppendText ( "Unknown" )
     Call rtitem.AddNewLine( 1 )
     
    End Select
    
   End If
  Next
  
  Call rtitem.AddNewLine( 1 )
  
 End If
 
 Exit Sub
 
ErrorHandler:
 Set memodoc = New NotesDocument(db)
 Dim recipients As String
 recipients = "Bryce Berry"     
 memodoc.form = "Memo"
 memodoc.subject = "Group Members Agent"
 msg = "Error #" & Format$(Err) & " at line " & Format$(Erl) & ": " & Error$
 memodoc.body = msg
 Call memodoc.Send(False, recipients)          
 
End Sub

Dig Deeper on Lotus Notes Domino Administration Tools

Start the conversation

Send me notifications when other members comment.

Please create a username to comment.

-ADS BY GOOGLE

SearchWindowsServer

Search400

  • iSeries tutorials

    Search400.com's tutorials provide in-depth information on the iSeries. Our iSeries tutorials address areas you need to know about...

  • V6R1 upgrade planning checklist

    When upgrading to V6R1, make sure your software will be supported, your programs will function and the correct PTFs have been ...

  • Connecting multiple iSeries systems through DDM

    Working with databases over multiple iSeries systems can be simple when remotely connecting logical partitions with distributed ...

SearchDataCenter

SearchContentManagement

Close