Option Public
Option Declare

Sub Initialize
	' replaces Notes names w/e-mail addresses in groups to secondary directory
	Dim sdbnm As String					' name of source directory
	Dim tdbnm As String					' name of target directory w/groups to update
	Dim soumask As String					' organizational match of name to location and change
	Dim gskiptype As String					' group type to modify
	Dim doselflag As Integer					' do selected docs instead of all in lookup group view
	
	' *************** Update Following Lines *********************
	sdbnm = "directoryinda.nsf"
	soumask = "OU=DeptName/O=CustName"
	tdbnm = "names.nsf"
	gskiptype = "2"								' 0=multi, 1=mail, 2=acl
	doselflag = 1
	' ***************************************************************
	
	Dim s As New NotesSession
	Dim db As NotesDatabase				' current db
	Dim gCol As NotesDocumentCollection				' selected docs collection if doselflag = 1
	Dim sDb As NotesDatabase				' source directory to pull data from
	Dim tDb As NotesDatabase				' target database w groups to update
	Dim sUV As NotesView					' source user view
	Dim tGV As NotesView					' target group view
	Dim tGDoc As NotesDocument				' group document
	
	' get both Directories
	Set db = s.CurrentDatabase
	Set sDb = LSGetDb(s, db.Server, sdbnm)
	Set tDb = LSGetDb(s, db.Server, tdbnm)
	If (sDb Is Nothing) Then
		' quit
		Print "Source Directory, " & sdbnm & ", could not be loaded. Aborted."
		Exit Sub
	End If
	If (tDb Is Nothing) Then
		' quit
		Print "Target Directory, " & tdbnm & ", could not be loaded. Aborted."
		Exit Sub
	End If
	Set sUV = sDb.GetView("$Users")
	Set tGV = tDb.GetView("($VIMGroups)")
	If (sUV Is Nothing) Then
		' quit
		Print "Source person view, $Users, could not be loaded. Aborted."
		Exit Sub
	End If
	If (tGV Is Nothing) Then
		' quit
		Print "Target group view, $VIMGroups, could not be loaded. Aborted."
		Exit Sub
	End If
	
	' check selected toggle
	If (doselflag = 1) Then
		' do selected docs
		Set gCol = db.UnprocessedDocuments
		If (gCol.Count = 0) Then
			' done
			Print "No groups to process. Done."
			Exit Sub
		End If
		Print "Have " & Cstr(gCol.Count) & " to process."
		Set tGDoc = gCol.GetFirstDocument()
		While Not (tGDoc Is Nothing)
			Call ProcessGroup(tGDoc, sUV, soumask, gskiptype) 
			' loop
			Set tGDoc = gCol.GetNextDocument(tGDoc)
		Wend
	Else
		' traverse group view
		Set tGDoc = tGV.GetFirstDocument()
		While Not (tGDoc Is Nothing)
			Call ProcessGroup(tGDoc, sUV, soumask, gskiptype) 
			' loop
			Set tGDoc = tGV.GetNextDocument(tGDoc)
		Wend
	End If
	
	Print "Agent run completion."
	
End Sub

Function LSGetDb(s As NotesSession, snm As String, dbnm As String) As NotesDatabase
	' get's database by name and returns it
	Dim tmpDb As NotesDatabase
	
	On Error Goto FErrorHandler
	
	' get database
	Set LSGetDb = Nothing
	Set tmpDb = s.GetDatabase(snm, dbnm, False)
	If (tmpDb Is Nothing) Then
		Exit Function
	End If
	If Not (tmpDb.IsOpen) Then
		' will usually through error if acl not allowed
		Call tmpDb.Open(snm, dbnm)
		If Not (tmpDb.IsOpen) Then
			' give up and return nothing
			Set tmpDb = Nothing
		End If
	End If
	Set LSGetDb = tmpDb
	
FExit:	
	Exit Function
	
FErrorHandler:
	Set LSGetDb = Nothing
	Set tmpDb = Nothing
	Resume FExit
End Function

Function ProcessGroup(tGDoc As NotesDocument, sUV As NotesView, soumask As String, gskiptype As String) As Integer
	' processes view loopingthrough members replacing maching members to soumask w/e-mail if found
	Dim mFld As NotesItem						' members field
	Dim mLst() As String							' replacement list of members
	Dim mcount As Long							' counter for mLst
	Dim curpos As Integer						' mask test
	Dim curm As String							' current member to find
	Dim sUDoc As NotesDocument			' source user doc to get e-mail
	Dim suemail As String						' email address of user
	Dim supflag As String							' flag to save group or not
	
	ProcessGroup = 0
	mcount=0
	supflag = 0
	
	' check if group type is to be skipped
	If (tGDoc.GroupType(0) = gskiptype) Then
		' skip
		Exit Function
	End If
	
	' setup list and get members
	Redim mLst(mcount)
	' get members field
	Set mFld = tGDoc.GetFirstItem("Members")
	If (mFld Is Nothing) Then
		Exit Function
	End If
	
	' loop through members
	Forall membernm In mFld.Values
		curm = Cstr(membernm)
		suemail = ""
		' process group member
		If Not (curm = "") Then
			' see if matches mask
			curpos = Instr(1, curm, soumask, 5)
			If (curpos > 0) Then
				' get user doc
				Set sUDoc = sUV.GetDocumentByKey(curm, True)
				If (sUDoc Is Nothing) Then
					' check for @ and trim to left of it and retry
					curm = Strleft(curm, "@", 5)
					Set sUDoc = sUV.GetDocumentByKey(curm, True)
				End If
				If Not (sUDoc Is Nothing) Then
					' get e-mail address
					suemail = sUDoc.InternetAddress(0)
				End If
			End If
		End If
		' add current entry to list
		Redim Preserve mLst(mcount)
		If (suemail = "") Then
			mLst(mcount) = curm
		Else
			mLst(mcount) = suemail
			supflag = 1
		End If
		mcount = mcount + 1
	End Forall
	
	' save group if flag set
	If (supflag = 1) Then
		Call tGDoc.ReplaceItemValue("Members", mLst() )
		Call tGDoc.Save(True, False)
		Print "Saved group: " & tGDoc.ListName(0)
	End If
	ProcessGroup = 1
	
FExit:
	Exit Function
	
FErrorHandler:
	Print "(ProcessGroup) Error: " & Cstr(Err) & " " & Error$ & ", line: " & Cstr(Erl)
	Resume FExit
End Function