GroupMembersReport (agent)

(Options)
Option Public
Option Declare

(Declarations)
Dim gMLst As Variant								' group members

Sub Initialize
	' agent mines group and sends e-mail with results
	Dim snm As String					' server w/names.nsf
	Dim gnm As String					' group name to mine
	Dim sendtonm As String			' person to receive report
	' ******************* update below **********
	snm = "cn=myserver/0=mydomain"
	gnm = "mygroupname"
	sendtonm = "My Name/OU/Org@Domain"
	'**********************************************
	
	Dim s As New NotesSession
	Dim db As NotesDatabase							' current db
	Dim nDb As NotesDatabase						' directory
	Dim nV As NotesView									' groups view
	Dim nvnm As String									' groups lookup view name
	Dim nDoc As NotesDocument						' group doc
	Dim gmLst As Variant									' list of group members
	
	On Error Goto SErrorHandler
	
	Set db = s.CurrentDatabase
	' get directory and lookup view
	Set nDb =GetServerDb(s, snm, "names.nsf")
	If (nDb Is Nothing) Then
		Print "Cancelled. Unable to get Domino Directory on server: " & snm & "."
		Exit Sub
	End If
	nvnm = "($VIMGroups)"
	Set nV = nDb.GetView(nvnm)
	If (nV Is Nothing) Then
		Print "Cancelled. Unable to get view, " & nvnm & ", in Domino Directory on server: " & snm & "."
		Exit Sub
	End If
	' get group
	Set nDoc = nV.GetDocumentByKey(gnm)
	If (nDoc Is Nothing) Then
		Print "Cancelled. No group named, " & gnm & ", in Domino Directory on server: " & snm & ". Done."
		Exit Sub
	End If
	' process group members
	gmLst = ProcessGroup(nDb, nV, nDoc)
	
	' have list, e-mail
	Call DoNotify(db, nDb, nDoc, gmLst , sendtonm)
	
	' done
	Print "Done execution."
SExit:
	Exit Sub
	
SErrorHandler:
	Print "(GroupMembersReport - Initialize) Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & ". <br>"
	Resume SExit
	
End Sub


Function GetServerDb(s As NotesSession, servernm As String, dbfilepath As String) As NotesDatabase
	' gets app by server and path, returns nothing if not able to get and open
	Dim aDb As NotesDatabase		' database to get
	
	On Error Goto FErrorHandler
	
	Set aDb = s.GetDatabase(servernm, dbfilepath, False)
	If (aDb Is Nothing) Then
		Set GetServerDb = Nothing
		Exit Function
	End If
	If (aDb.IsOpen) Then
		' return app
		Set GetServerDb = aDb
		Exit Function
	Else
		' try to open again
		Call aDb.Open(servernm, dbfilepath)
		If (aDb.IsOpen) Then
			' return app
			Set GetServerDb = aDb
			Exit Function
		Else
			' not open still, return nothing
			Set aDb = Nothing
			Set GetServerDb = Nothing
			Exit Function
		End If
	End If
	
FExit:
	Exit Function
	
FErrorHandler:
	Print "(GetServerDb) Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & ". <br>"
	Set GetServerDb = Nothing
	Resume FExit
End Function

Function ProcessGroup(nDb As NotesDatabase, nV As NotesView, nDoc As NotesDocument) As Variant
	' processes group membership
	' nDb - names.nsf
	' nV - group lookup view
	' nDoc - current group document to get members
	
	Dim nMembers As NotesItem				' nDoc group member field
	Dim gmV As NotesView						' member view
	Dim gmNm As NotesName					' member name for nest check
	Dim gsubDoc As NotesDocument		' member that turns out to be nested group name
	Dim gmembernm As String					' current name in members field values
	Dim gmLst As Variant							' list of members mined
	Dim gmsLst As Variant						' sub list to add back to main list
	
	On Error Goto FErrorHandler
	
	' setup list
	Redim gmLst(0)
	gmLst(0) = ""
	
	' get members field
	Set nMembers = nDoc.GetFirstItem("Members")
	If (nMembers Is Nothing) Then
		' return failure
		gmLst(0) = "<error - no members field in group>"
		ProcessGroup = gmLst
		Exit Function
	End If
	If (nMembers.Text="") Then
		' no members, done
		Print "Group empty."
		gmLst(0) = "<no members found>"
		ProcessGroup = gmLst
		Exit Function
	End If
	
	' loop through member values and mine
	Forall membernm In nMembers.Values
		gmembernm = Trim(Cstr(membernm))
		If Not (gmembernm = "") Then
			' check if current item is also a group
			Set gmNm = New NotesName(gmembernm)
			If Not (gmNm Is Nothing) Then
				Set gsubDoc = nV.GetDocumentByKey( gmNm.Abbreviated)
			End If				' end gmNm nothing test
			' check if we have nested group doc
			If (gsubDoc Is Nothing) Then
				' current entry/name not a group, add name to list
				gmLst = ListAdd(gmLst, gmembernm)
				
			Else
				' current entry is a group, mine nest
				' *** start recursive call *******
				gmsLst = ProcessGroup(nDb, nV, gsubDoc)
				' add any members of sub group to this group
				Forall submembernm In gmsLst
					Call ListAdd(gmLst, Cstr(submembernm))
				End Forall
				' *** end recursive call ********
			End If
		End If
	End Forall
	' return final list for current group
	ProcessGroup = gmLst
	
FExit:
	Exit Function
	
FErrorHandler:
	Print "(ProcessGroup) Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & ". <br>"
	Resume FExit
End Function

Function ListAdd(inLst As Variant, newvalstr As String) As Variant
	' adds to existing array
	' inLst - current array being appended to
	' newvalstr - value to be added to inLst
	Dim lstsize As Long									' counter/size of inLst
	
	On Error Goto FErrorhandler
	
	If (Isempty(inLst)) Then
		Redim inLst(0) As String
	End If
	
	' start with return list = starting list
	ListAdd = inLst
	
	If (Ubound(inLst) = Lbound(inLst) And inLst(Ubound(inLst)) = "" ) Then				' error 200 if not initialized
		' empty array, add value on top of first value
LstInitialized:
		inLst(Lbound(inLst) ) = newvalstr
	Else
		' add to existing array
		lstsize = Ubound(inLst) + 1
		Redim Preserve inLst(lstsize)
		inLst(lstsize) = newvalstr
	End If
	' return updated list
	ListAdd = inLst
	
FExit:
	Exit Function
	
FErrorHandler:
	If (Err=200) Then 
		' list passed into function not initialized
		Redim inLst(0 To 0)
		Resume LstInitialized
	Else
		' unexpected error, abort
		Print "(ListAdd) Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & ". <br>"
		Resume FExit
	End If
End Function

Function DoNotify(db As NotesDatabase, nDb As NotesDatabase, nDoc As NotesDocument, gmLst As Variant , sendtonm As String) As Integer
	' send results of report to sendtonm
	Dim mailDoc As NotesDocument				' the mailer doc
	Dim body As NotesRichTextItem					' the body field of memo
	
	On Error Goto FErrorHandler
	
	' create new memo
	Set mailDoc = db.CreateDocument
	mailDoc.SaveMessageOnSend = False
	mailDoc.Form = "Memo"
	mailDoc.From = db.Server
	mailDoc.ReplyTo = sendtonm
	mailDoc.SendTo = sendtonm
	mailDoc.Principal = sendtonm
	mailDoc.Subject = |Group membership report for group: | & nDoc.ListName(0) & |.|
	Set body = New NotesRichTextItem(mailDoc, "Body")
	Call body.AppendText("Group Members: ")
	Call body.AddNewline(1)
	Forall y In gmLst
		Call body.AppendText(Cstr(y)  & ", ")
	End Forall
	Call body.AddNewline(1)
	
	' add doclink
	Call body.AppendText("Doclink to Directory:")
	Call body.AppendDocLink(nDb, db.Title)
	Call body.AddNewline(1)
	' send memo
	Call mailDoc.Send(False, sendtonm)
	' return success to main function
	DoNotify=1
	
FExit:
	Exit Function
	
FErrorHandler:
	Print "(DoNotify) Unexpected Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & ". <br>"
	DoNotify = 0
	Resume FExit
End Function