has the boolean function so is R6 only :)
This version uses davids Code and allows the user to remove people
Also adds in Valid Groups/Servers/Mail DBs
It 'Remembers if you want to keep or delete the entry for subsequent groups
Also modified the IsValidPerson Function to exit the forall loop when a user was found (the address book I had to play with had 2000 entries
so heres all the Code
Declarations
Dim PeopleList() As String
Dim PeopleCount As Integer
Dim DeleteList() As String
Dim DeleteCount As Integer
Dim KeepList() As String
Dim KeepCount As Integer
Sub Click(Source As Button)
'
' This Code creates a list of all email groups and their associated members. It also
' does a lookup to confirm the group members are valid Notes users
'
' To report this information, it requires one field on the form
' named "Body" which is RichText and Editable
'
' There is one Function "IsValidPerson" and two Global Declarations
Dim workspace As New NotesUIWorkspace
Dim session As New NotesSession
Dim db As New NotesDatabase( "", "" )
Dim GroupView As NotesView
Dim PersonView As NotesView
Dim GroupDoc As NotesDocument
Dim PersonDoc As NotesDocument
Dim uidoc As NotesUIDocument
Dim rtitem As Variant
Dim backdoc As NotesDocument
Dim txtServer As String
Dim txtFilename As String
Dim Nam As NotesName
Dim ntitem As notesitem
Dim rtext As NotesRichTextItem
Dim MessageStr As String
Dim GroupDocChanged As Boolean
Dim LogEvent As Boolean
Set uidoc = workspace.CurrentDocument
Set backdoc = uidoc.Document
Call uidoc.GotoField("Marker")
Set rtext = New NotesRichTextItem( backdoc, "Body" )
' Get the Server of the Address Book
Dim s As New NotesSession
Forall book In s.AddressBooks
book.open "", ""
If Book.Server<>"" Then
tmpServer=Book.Server
tmpFileName=Book.FileName
Exit Forall
End If
End Forall
' Prompt user to confirm server name and filename
txtServer = workspace.Prompt (PROMPT_OKCANCELEDIT, "Server Name", "Server to check.", tmpServer)
If Isempty (txtServer) Then
Exit Sub
End If
txtFilename = workspace.Prompt (PROMPT_OKCANCELEDIT, "Address Book", "Filename on "+txtServer+"?", tmpFilename)
If Isempty (txtFilename) Then
Exit Sub
End If
'Set ntitem = backdoc.ReplaceItemValue("Body","")
Call uidoc.FieldAppendText( "Body", "Report Started :"+Cstr(Now()))
Call uidoc.FieldAppendText( "Body",Chr(10))
Call uidoc.FieldAppendText( "Body", "Checking Server :"+txtServer)
Call uidoc.FieldAppendText( "Body",Chr(10))
Call uidoc.FieldAppendText( "Body", "Using NAB :"+txtFileName)
Call uidoc.FieldAppendText( "Body",Chr(10))
' Attempt to Open the server address book
If Not db.Open(txtServer, txtFilename ) Then
Msgbox "Failed to Open the Address Book",16,"Warning"
Call uidoc.FieldAppendText( "Body", "Aborted " + Cstr(Now()))
Call uidoc.FieldAppendText( "Body",Chr(10))
Exit Sub
End If
' Get List of People
PeopleCount=0
DeleteCount = 0
KeepCount = 0
GroupDocChanged = False
LogEvent = False
Set PersonView=db.GetView("People")
Set PersonDoc=PersonView.GetFirstDocument
Print "Getting List of Valid Users."
While Not PersonDoc Is Nothing
PeopleCount=PeopleCount+1
If( PeopleCount Mod 10) = 0 Then
Call uidoc.FieldAppendText( "Body",">")
End If
Redim Preserve PeopleList(PeopleCount)
PeopleList(PeopleCount)=Ucase(PersonDoc.FullName(0))
Set PersonDoc=PersonView.GetNextDocument(PersonDoc)
Wend
'Get Valid Groups
Set PersonView=db.GetView("Groups")
Set PersonDoc=PersonView.GetFirstDocument
Print "Getting List of Valid Groups"
While Not PersonDoc Is Nothing
PeopleCount=PeopleCount+1
If( PeopleCount Mod 10) = 0 Then
Call uidoc.FieldAppendText( "Body",">")
End If
Redim Preserve PeopleList(PeopleCount)
PeopleList(PeopleCount)=Ucase(PersonDoc.ListName(0))
Set PersonDoc=PersonView.GetNextDocument(PersonDoc)
Wend
'Get Valid Servers
Set PersonView=db.GetView("$Servers")
Set PersonDoc=PersonView.GetFirstDocument
Print "Getting List of Valid Servers"
While Not PersonDoc Is Nothing
PeopleCount=PeopleCount+1
If( PeopleCount Mod 10) = 0 Then
Call uidoc.FieldAppendText( "Body",">")
End If
Redim Preserve PeopleList(PeopleCount)
PeopleList(PeopleCount)=Ucase(PersonDoc.serverName(0))
Set PersonDoc=PersonView.GetNextDocument(PersonDoc)
Wend
'get Mail-In DatabasesCat
Set PersonView=db.GetView("Mail-In DatabasesCat")
Set PersonDoc=PersonView.GetFirstDocument
Print "Getting List of Valid Mail IN DB's"
While Not PersonDoc Is Nothing
PeopleCount=PeopleCount+1
If( PeopleCount Mod 10) = 0 Then
Call uidoc.FieldAppendText( "Body",">")
End If
Redim Preserve PeopleList(PeopleCount)
PeopleList(PeopleCount)=Ucase(PersonDoc.FullName(0))
Set PersonDoc=PersonView.GetNextDocument(PersonDoc)
Wend
Call uidoc.FieldAppendText( "Body",Chr(10))
Call uidoc.FieldAppendText( "Body", "Group Report - Members List. "+Str(Now))
Call uidoc.FieldAppendText( "Body",Chr(10))
Call uidoc.FieldAppendText( "Body",Chr(10))
' Work Through Groups
Set GroupView=db.GetView("Groups")
Print "Checking " + Cstr(groupview.EntryCount) + " Groups"
Set GroupDoc=GroupView.GetFirstDocument
While Not GroupDoc Is Nothing
' Get Group Type
Select Case GroupDoc.GroupType(0)
Case "0" : tmpGroupType="[Multipurpose]"
Case "1" : tmpGroupType="[Mail Only]"
Case "2": tmpGroupType="[Access Control List Only]"
Case "3" : tmpGroupType="[Deny List Only]"
Case "4" : tmpGroupType="[Servers Only]"
End Select
Call uidoc.FieldAppendText( "Body", GroupDoc.ListName(0))
Call uidoc.FieldAppendText( "Body",Chr(10))
Forall GroupMember In GroupDoc.Members
' Convert Name to Abbreviated format
Set Nam=session.CreateName(GroupMember)
tmpName=Nam.Abbreviated
If Not IsValidPerson(Ucase(GroupMember)) Then
If Not isKeepPerson(Ucase(GroupMember)) Then
If IsDeletedPerson(Ucase(GroupMember)) Then
MessageStr = " Removed"
GroupDoc.Members = RemoveFromList(GroupMember,GroupDoc.Members)
GroupDocChanged = True
LogEvent = True
Else
ans% =Workspace.Prompt(2,"Delete All Occurances of this User","Remove User : " + TmpName)
If Ans% = 1 Then
AddtoDeleteList(Ucase(GroupMember))
GroupDoc.Members = RemoveFromList(GroupMember,GroupDoc.Members)
GroupDocChanged = True
MessageStr = " Removed **"
LogEvent = True
Else
AddtoKeepList(Ucase(GroupMember))
MessageStr = " Not Removed**"
LogEvent = False
End If
End If
Else
MessageStr = " Not Removed"
LogEvent = False
End If
If LogEvent Then
Call uidoc.FieldAppendText( "Body", Chr(9)+Ucase(tmpName) + MessageStr)
Call uidoc.FieldAppendText( "Body",Chr(10))
End If
Print tmpName+" - NOT A VALID USER " + MessageStr
Call uidoc.Refresh
Else
'Call uidoc.FieldAppendText( "Body", Chr(9)+tmpName)
'Call uidoc.FieldAppendText( "Body",Chr(10))
End If
End Forall
If GroupDocChanged Then
success = groupdoc.Save(True,False)
End If
Set GroupDoc=GroupView.GetNextDocument(GroupDoc)
GroupDocChanged = False
Wend
Call uidoc.FieldAppendText( "Body", Chr(9)+"Report Completed " + Cstr(Now()))
Call uidoc.FieldAppendText( "Body",Chr(10))
Call uidoc.Refresh
Call backdoc.Save(True,False)
End Sub
Function IsKeepPerson(tmpPerson)
IsKeepPerson=False
Forall People In KeepList
If People=tmpPerson Then
IsKeepPerson=True
Exit Forall
End If
End Forall
End Function
Function AddToKeepList(Keepname As String)
KeepCount=KeepCount+1
Redim Preserve KeepList(KeepCount)
KeepList(KeepCount)=KeepName
End Function
Function IsValidPerson(tmpPerson)
IsValidPerson=False
Forall People In PeopleList
If People=tmpPerson Then
IsValidPerson=True
Exit Forall
End If
End Forall
End Function
Function AddToDeleteList(Deletename As String)
DeleteCount=DeleteCount+1
Redim Preserve DeleteList(DeleteCount)
DeleteList(DeleteCount)=DeleteName
End Function
Function IsDeletedPerson(tmpPerson As String)
IsDeletedPerson=False
Forall People In DeleteList
If People=tmpPerson Then
IsDeletedPerson=True
Exit Forall
End If
End Forall
End Function
Function RemoveFromList (Value As Variant, ValueList As Variant)
Dim tmpValueList() As String
x = 0
Redim Preserve tmpValueList(x)
Forall vals In ValueList
If Not Value = vals Then
Redim Preserve tmpValueList(x)
tmpValueList(x) = vals
x = x + 1
End If
End Forall
RemoveFromList = tmpValueList
End Function

Login to add your comment