'Update_Remove_Docs_Not_Modified_In_The_Last_X_Days: 

Option Declare

Sub Click(Source As Button)
	
	'=================================================
	' 
	' Button 'Update Remove Docs Not Modified In The Last X Days'
	' 
	' Author	: Marc Champoux
	' Date	: March 3rd 2010
	'
	' Description ...
	'
	' This button will start by prompting to select which servers to
	' process. Once the servers are selected, the code will open
	' the mail tracking store database on each of the selected
	' servers and then update the number of days in the field 
	' "Remove Documents Not Modified In the Last (days)".
	'
	'=================================================
	
	'=================================================
	' Declarations ...
	'=================================================
	
	Dim NUIWs As New NotesUIWorkspace			' The Notes UI Workspace object.
	Dim Session As New NotesSession					' The current notes session.
	Dim EmailSendTo As Variant							' The SendTo of the email.
	Dim EmailDoc As NotesDocument					' A document that will be emailed.
	Dim EmailBody As NotesRichTextItem				' The body of the document that will be emailed.
	
	Dim CurrDb As NotesDatabase						' The current database.
	Dim CurrDbServerStr As String						' The current server as a string.
	Dim CurrDbServerName As NotesName			' The current server as a notes name.
	
	Dim DirectoryDB As NotesDatabase				' The Domino Directory.
	Dim DirectoryDBView As NotesView					' A view with the servers names in the Domino Directory.
	Dim DirectoryDBDocsSelected As NotesDocumentCollection		' The collection of server docs selected.
	Dim DirectoryDBDoc As NotesDocument			' 1 server doc from the collection.
	
	Dim TargetServerNameStr As String				' The server name to open in string format.
	Dim TargetServerName As NotesName			' The target server name in string format.
	
	Dim ServerCount As Integer							' The count of servers processed.
	Dim ServerCountTotal As Integer						' The total count of servers to process.
	
	Dim MTStoreDB As NotesDatabase					' The Mail Tracking Store db.
	Dim MTStoreRepl As NotesReplication			' The Replication Settings of the Mail Tracking store db.
	
	Dim CutOffCounter As Integer							' A counter to build the cut off days array.
	Dim CutOffOptions ( 1 To 12 ) As String			' The number of days to keep in the Mail Tracking Store.
	Dim CutOffSelected As Variant							' The value selected ...
	
	Dim CurrentCutOff As Long								' The current cut off setting.
	Dim NewCutOff As Long									' The new cut off setting.
	
	Dim Continue As Integer									' The return value of a Messagebox 
	
	'=================================================
	' Initialize ...
	'=================================================
	
	' Print something ...
	Print "Update Remove Docs Not Modified In The Last X Days Setting : Starting ..."
	
	' Set the array with the number of days ...
	For CutOffCounter = 1 To 12 Step 1
		CutOffOptions ( CutOffCounter ) = Cstr ( CutOffCounter * 30 ) + " Days"
	Next
	
	' Prompt the to select the new number of days ...
	CutOffSelected = NUIWs.Prompt( 4, "How Many Days Should the Mail Tracking Store Keep?", "Please select from the list below: ", "", CutOffOptions )
	
	' Validate ...
	If CutOffSelected = "" Then
		Messagebox "You need to select the number of days to keep in the Mail Tracking Store. Please try again." , 48 , "Error - No Selection."
		Exit Sub
	Else
		' Get the new cut off ...
		NewCutOff = Clng ( Left ( CutOffSelected , Instr ( CutOffSelected , " " ) - 1 ) )
	End If
	
	'=================================================
	' 1 - Check which server we are on ...
	'=================================================
	
	' Get the current database ...
	Set CurrDb = Session.CurrentDatabase
	
	' Get the current server ...
	CurrDbServerStr = CurrDb.Server
	
	' Make sure we have a server ... and if we do, put it in a notesname object ...
	If CurrDbServerStr = "" Then
		Messagebox "Sorry, but you need to run this code from a server. Try again." , 48 , "Error - Running from Local."
		Exit Sub
	Else
		Set CurrDbServerName = New NotesName ( CurrDbServerStr )
	End If
	
	'=================================================
	' 2 - Open the Domino Directory ....
	'=================================================	
	
	' Note: Seriously, all this is not needed but I'm a defensive programmer so I always try to make sure that
	' the database exists and the view is there before doing a prompt with the picklistcollection method (which
	' you'll see in the next part).
	
	' Get the Domino Directory ...
	Set DirectoryDB = Session.GetDatabase ( CurrDbServerName.Abbreviated , "names.nsf" , False )
	
	' Check if the Domino Direcctory is opened ...
	If DirectoryDB.IsOpen = False Then
		Messagebox "Sorry but I can't open the Domino Directory (names.nsf) on the " + CurrDbServerName.Abbreviated + " server ... please try again." , 48 , "Error - Can't open Names.nsf"
		Exit Sub
	Else
		Print "Opened Domino Directory on " + CurrDbServerName.Abbreviated + " ..."
	End If
	
	' Get the view with the server names ... (the Servers\Servers view ... with the alias Servers)
	Set DirectoryDBView = DirectoryDB.GetView ( "Servers" )
	
	' Check if the view is opened ...
	If DirectoryDBView Is Nothing Then
		Messagebox "Sorry but I can't open the view ""Servers\Servers"" in Domino Directory (names.nsf) on the " + CurrDbServerName.Abbreviated + " server ... please try again." , 48 , "Error - Can't open View in Names.nsf"
		Exit Sub
	End If
	
	'=================================================
	' 3 - Select the servers to scan ...
	'=================================================	
	
	' Prompt the user ...
	Set DirectoryDBDocsSelected = NUIWS.PickListCollection( 3 , True, DirectoryDB.Server, DirectoryDB.FilePath, DirectoryDBView.Name, "Select 1 or More Servers", "Please select server(s) from the list below and click OK..." )
	
	' Do some validation ...
	If DirectoryDBDocsSelected Is Nothing Then
		Print "No servers selected ... exiting ..."
		Exit Sub
	Else
		If DirectoryDBDocsSelected.Count = 0 Then
			Print "User pressed Cancel ... exiting ..."
			Exit Sub
		End If
	End If
	
	' Now make sure that we want to continue ...
	If DirectoryDBDocsSelected.Count = 1 Then
		Continue = Messagebox ( "You are about to check (and update when needed) the Number of Days to Keep in the Mail Tracking Store of " + Cstr ( DirectoryDBDocsSelected.Count ) + " server." + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + "The Number of Days to Keep will be set to : " + Cstr ( NewCutOff ) + " days." + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + "Do you want to continue?" , 36 , "Continue?" )		
	Else
		Continue = Messagebox ( "You are about to check (and update when needed) the Number of Days to Keep in the Mail Tracking Store of " + Cstr ( DirectoryDBDocsSelected.Count ) + " servers." + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + "The Number of Days to Keep will be set to : " + Cstr ( NewCutOff ) + " days." + Chr$(10) + Chr$(13) + Chr$(10) + Chr$(13) + "Do you want to continue?" , 36 , "Continue?" )		
	End If
	
	' Check if we continue or not ...
	If Continue = 7 Then
		Print "Operation Cancelled ..."
		Exit Sub
	End If
	
	'=================================================
	' Loop in the server docs ...
	'=================================================
	
	' Set some counters ...
	ServerCountTotal = DirectoryDBDocsSelected.Count
	ServerCount = 0
	
	' Get the 1st server doc in the collection ..
	Set DirectoryDBDoc = DirectoryDBDocsSelected.GetFirstDocument ()
	
	' Loop ...
	While Not ( DirectoryDBDoc Is Nothing )
		
		' Increase the counter ...
		ServerCountTotal = DirectoryDBDocsSelected.Count
		ServerCount = ServerCount + 1
		
		' Check to see if the "ServerName" field exist ...
		If DirectoryDBDoc.HasItem ( "ServerName" ) Then
			
			' Get the server name ...
			TargetServerNameStr = DirectoryDBDoc.GetFirstItem ( "ServerName" ).Text
			Set TargetServerName = New NotesName ( TargetServerNameStr )
			
			' Print something ...
			Print "Processing Server " + Cstr ( ServerCount ) + " of " + Cstr ( ServerCountTotal ) + " : " + TargetServerName.Abbreviated + " ..."
			
			' Try to open the mail tracking store database on that server ...
			Set MTStoreDB = Session.GetDatabase ( TargetServerName.Abbreviated , "mtdata\\mtstore.nsf" , False )
			
			' Check to see if we have something ...
			If Not (MTStoreDB Is Nothing ) Then
				
				' Check to see if it's opened ...
				If MTStoreDB.IsOpen Then
					
					' Try to get the Replication settings
					Set MTStoreRepl = MTStoreDB.ReplicationInfo
					
					' Check if we have the replicaiton information ...
					If Not ( MTStoreRepl Is Nothing ) Then
						
						' Now that we have the replication settings ... get the Cut Off Setting ...
						CurrentCutOff = MTStoreRepl.CutoffInterval
						
						' Print something ....
						Print "Processing Server " + Cstr ( ServerCount ) + " of " + Cstr ( ServerCountTotal ) + " : " + TargetServerName.Common + " : Tracking Store Currently Set to Keep " + Cstr ( CurrentCutOff ) + " Days ..."
						
						' Check if the value is different ...
						If CurrentCutOff <> NewCutOff Then
							
							' Set the new Cut Off Days ...
							MTStoreRepl.CutoffInterval = NewCutOff
							
							' Save the Replication Settings
							Call MTStoreRepl.Save ( )
							
							' Print something ...
							Print "Processing Server " + Cstr ( ServerCount ) + " of " + Cstr ( ServerCountTotal ) + " : " + TargetServerName.Common + " : Tracking Store Updated to Keep " + Cstr ( NewCutOff ) + " Days ..."
							
						Else
							
							' We are already set to the right value ...
							Print "Processing Server " + Cstr ( ServerCount ) + " of " + Cstr ( ServerCountTotal ) + " : " + TargetServerName.Common + " : Tracking Store Already Set to Keep " + Cstr ( NewCutOff ) + " Days ..."
							
						End If	' End of the "If CurrentCutOff <> NewCutOff Then"
						
					Else
						
						' Oups, we can't open the mail tracking store a particular server ...
						Messagebox "Sorry but I can't get the Replication Settings of the Mail Tracking Store (mtdata\mtstore.nsf) on the " + TargetServerName.Abbreviated + " server.  Please process that database manually." , 64 , "FYI - Can't Get Replication Settings ..."
						
					End If	' End of the "If Not ( MTStoreRepl Is Nothing ) Then"
					
				Else
					
					' Oups, we can't open the mail tracking store a particular server ...
					Messagebox "Sorry but I can't open the Mail Tracking Store (mtdata\mtstore.nsf) on the " + TargetServerName.Abbreviated + " server.  Please process that database manually." , 64 , "FYI - Can't Open Mail Tracking Store..."
					
				End If	' End of the "If MTStoreDB.IsOpen Then"
				
			Else
				
				' Oups, we can't open the mail tracking store a particular server ...
				Messagebox "Sorry but either I can't reach this particular server OR the Mail Tracking Store (mtdata\mtstore.nsf) database does not exist on the " + TargetServerName.Abbreviated + " server.  Please verify that you can connect to that server, then enable Mail Tracking on that server and, finally, set the Cut Off Date Manually." , 64 , "FYI - Server Not Responding OR No Mail Tracking Store..."
				
			End If	' End of the "If Not (MTStoreDB Is Nothing ) Then"
			
		Else
			
			Messagebox "There is a document in the view which does not have a ""ServerName"" field ... please investigate while I continue scanning the other servers" , 64 , "FYI - Missing ServerName Field"
			
		End If	' End of the "If DirectoryDBDoc.HasItem ( "ServerName" ) Then"
		
		' Get the next server doc in the collection ...
		Set DirectoryDBDoc = DirectoryDBDocsSelected.GetNextDocument ( DirectoryDBDoc )
		
	Wend
	
	' Print something ...
	Print "Update Remove Docs Not Modified In The Last X Days Setting : Finished ..."
	
End Sub