Options
Option Public
Option Declare

Sub Initialize
	Dim servernm As String			' mail file server
	Dim filepathnm As String			' mail file filepath
	' update below
	servernm = ""
	filepathnm ="folder/filenm.nsf"
	
	' do rest of prep
	Dim s As New NotesSession
	Dim mDb As NotesDatabase					' mail app
	Dim debugmode As String
	debugmode = "1"
	Set mDb = GetAppDb(s, servernm, filepathnm, debugmode)
	If (mDb Is Nothing) Then
		' abort
		Print "Unable to load application. Aborted."
		Exit Sub
	End If
	
	' have app, process it
	Call CompactMailRules (mDb)
	
	' done
	Print "Agent Done. See above lines for any errors."
	
End Sub

Function CompactMailRules (db As NotesDatabase) As Integer
	' reloads calendar profile of db object passed
	
	Static nErrors As Integer
	
	Dim session As New NotesSession
' Dim db As NotesDatabase
	Dim tmpRuleDoc As NotesDocument
	Dim tmpView As NotesView
	Dim tmpViewCollection As NotesViewEntryCollection
	Dim tmpViewEntry As NotesViewEntry
	Dim tmpNotesItem As notesitem
	Dim CalProfile As notesdocument
	Dim strFilterItem As String
	Dim nTotalEnableRules As Integer
	
	On Error Goto Errhandle
	
' Set db = session.CurrentDatabase
	Set CalProfile= db.GetProfileDocument("CalendarProfile")
	Set tmpView = db.GetView("(Rules)")
	Set tmpViewCollection = tmpView.AllEntries
	
'// Delete all $FilterFormula_x items off the Calendar Profile
'// $filterformula_0 is reserve to MiniView - leave it alone
	If Not(CalProfile Is Nothing) Then
'//Clean Profile from all $FilterFormula_x
		Forall items In CalProfile.items
			If items.type = 1536 Then
				If Lcase(Left(items.name,15)) = "$filterformula_" Then
					If Not ( Lcase( Left( items.name,16 ) ) = "$filterformula_0" ) Then '//Reseved for MiniView
						Call items.remove()
					End If
				End If
			End If
		End Forall
		
'//Reset counter
		nTotalEnableRules = 1
		
'//Synch Rule OrderNum with Profile $FilterFormula
		If Cint(tmpViewCollection.Count) > 0 Then
			Set tmpViewEntry = tmpViewCollection.getfirstentry()
			While Not( tmpViewEntry Is Nothing )
				nTotalEnableRules = nTotalEnableRules + 1
				Set tmpRuleDoc = tmpViewEntry.Document
'// Make sure Enabled Rules have a reference in the Calendar Profile
'// Disable Rules don't have a reference. Howerver, we need to reserve it's location in CalProfile
'// in case the user enables it again.
				If tmpRuleDoc.GetItemValue("Enable")(0) = "1" Then
					Set tmpNotesItem = tmpRuleDoc.GetFirstItem("$FilterFormula")
					strfilteritem = "$FilterFormula_"+Cstr(nTotalEnableRules)
					Call tmpNotesItem.copyitemtodocument(CalProfile,strfilteritem)
				End If
				
'// if the Rule in scope is out of sync, fix it!
				If (Cint(tmpRuleDoc.GetItemValue("OrderNum")(0)) <> nTotalEnableRules) Then
					Call tmpRuleDoc.replaceitemvalue("OrderNum", Cstr( nTotalEnableRules ) )
					Call tmpRuleDoc.Save(True,True)
				End If
'// Get next Rule
				Set tmpViewEntry = tmpViewCollection.GetNextEntry( tmpViewEntry )
			Wend
		End If
	End If
	
	CompactMailRules = Cint(nTotalEnableRules)
	
	Exit Function
	
Errhandle:
' Use the Err function to return the error number and
' the Error$ function to return the error message.
	
	If Err = 0 Or Err = 20 Then
		Resume Next
	Else
		Messagebox "Error" & Str(Err) & ": " & Error$
		CompactMailRules = 0
		Exit Function
	End If
	
End Function

Function GetAppDb(s As NotesSession, servernm As String, filepathnm As String, debugmode As String) As NotesDatabase
	' gets names.nsf, returns db object if successful; nothing, if not
	' s - used to get domDb directory
	' servernm - server name with Domino directory
	' filepathnm - filepath  to Domino directory on servernm
	' debugmode - developer breadcrumbs and error messages
	Dim domDb As NotesDatabase		' domino directory to update
	
	On Error Goto FErrorHandler
	
	' get db
	Set domDb = s.GetDatabase(servernm, filepathnm, False)
	If (domDb Is Nothing) Then
		' give up
		Set GetAppDb=Nothing
		Exit Function
	End If
	If Not (domDb.IsOpen) Then
		If (debugmode="1") Then
			Print "(GetAppDb) App did not open. ( " & servernm & ", " & filepathnm & "). "
		End If
		Call domDb.Open(servernm, filepathnm)
		If Not (domDb.IsOpen) Then
			' give up (this likely, will never execute, as if db did not open, error handler is returning nothing instead
			If (debugmode="1") Then
				Print "(GetAppDb) App could not be opened/accessed. ( " & servernm & ", " & filepathnm & "). "
			End If
			Set GetAppDb=Nothing
			Exit Function
		End If
	End If
	Set GetAppDb=domDb
	Exit Function
	
FErrorHandler:
	If (debugmode="1") Then
		Print "(GetAppDb) Unexpected error: ( " & Cstr(Err) & ") " & Error$ & ", on line: " & Cstr(Erl) & "."
	End If
	Set GetAppDb=Nothing
	Exit Function
	
End Function