Domino Code Fragment

Code Name*
Change all scheduled Agents to Run on different Server name		Date*
01/11/2002		Source (or email address if you prefer)*
[email protected]
IP address:.12.147.96.10
Description*
R5 - Administrator Assist
Moved/replicated countless databases from old servers to new. Servers were named differently. Had to fix all scheduled agent to set correctly to run on new server. 		Type*
LotusScript		Categories*
Design Configuration, (Misc)
Implementation:
None (plug and play)		Required Client:
5.0		Server:
5.0
Limitations:
Created via R5.08 designer		Comments:
Used in view action but can be run as agent. Works like a charm!
Files/Graphics attachments (if applicable): Code:
Declarations:
Dim Session As NotesSession
Dim CurrentDb As NotesDatabase
Dim LogRecord As NotesDocument

Click:

Sub Click(Source As Button)

DoConfirmationPrompt "This action will allow you to select "& _
"an old server name and replace with the new server name "& _
"for scheduled agents."

Dim TargetServer As String, OldServer As String, NewServer As String
GetRunParameters TargetServer, OldServer, NewServer
CreateNewLogRecord TargetServer, OldServer, NewServer

Dim DatabasesOnServer As New NotesDbDirectory( TargetServer )
Dim OneDatabase As NotesDatabase
Set OneDatabase = DatabasesOnServer.GetFirstDatabase( DATABASE )
On Error 4060 Resume Next

Dim DatabasesChecked As Integer, AgentsExamined As Integer
Dim DatabasesUpdated As Integer, AgentsUpdated As Integer
Dim OneDatabaseUpdated As Integer, SystemDbsSkipped As Integer
Dim DatabaseOpenOkay As Integer, MessageText As String

' Repeat for each database on the target server
Do Until OneDatabase Is Nothing
If IsSystemTypeDatabase (OneDatabase.FilePath) Then
Let SystemDbsSkipped = SystemDbsSkipped + 1
Else

'The database is not a "system" db, so proceed to open & process
Print "Looking at database " OneDatabase.FilePath
Let DatabaseOpenOkay = OneDatabase.Open ("","")
If Err = 4060 Then
AppendToLogRecord Error$()
'Msgbox Error$(), 48, "DON'T HAVE READ ACCESS ??"
Err = 0

Elseif Not DatabaseOpenOkay Then
Let MessageText = "The database does not "& _
"appear to exist at the given location. "& _
"FilePath="& OneDatabase.FilePath
AppendToLogRecord MessageText
Msgbox MessageText, 48, "DATABASE NOT FOUND"

Else
Let DatabasesChecked = DatabasesChecked + 1
' Check to ensure we do have agents to run on
If Not Isempty(OneDatabase.Agents) Then
Let OneDatabaseUpdated = False

' Repeat for each agent in a given database
Forall OneAgent In OneDatabase.Agents
Let AgentsExamined = AgentsExamined + 1
' Is agent set to run on "old server"?
If Instr(1,OneAgent.ServerName,OldServer,1)>0 Then
'Update the "run on server" setting
Let OneAgent.ServerName = NewServer
Call OneAgent.Save
Let AgentsUpdated = AgentsUpdated + 1
Let OneDatabaseUpdated = True
End If
End Forall

' Was at least one agent in db updated?
If OneDatabaseUpdated Then
Let DatabasesUpdated = DatabasesUpdated + 1
AppendToLogRecord "At least one "& _
"agent was updated in database "& _
OneDatabase.FilePath
End If
End If
End If
End If

' Fetch another database to pick on
Set OneDatabase = DatabasesOnServer.GetNextDatabase
Print 'Clear prior database from the message bar
Loop

' Display a brief report on screen showing database & agent
' ... counts collected above. Also update the log record
Let MessageText = "Out of a total of "& DatabasesChecked & _
" databases checked, "& DatabasesUpdated & _
" databases were updated,"& Chr$(10) &"and out of "& _
AgentsExamined &" agents examined, "& AgentsUpdated & _
" scheduled agents were updated."& Chr$(10) & Chr$(10) & _
"PS: "& SystemDbsSkipped & _
" system databases were skipped in this run."

AppendToLogRecord Chr$(10) & MessageText
Msgbox MessageText, 64, "TASK COMPLETION SUMMARY"
End

' This is a handling routine for database access errors
'WhatHappened:
' Msgbox "Database FilePath="& OneDatabase.FilePath & _
' Chr$(10) &"ERROR#"& Err() &" in Line#"& Erl() & _
' " :: "& Error$(), 48, "COULD NOT OPEN DB"
' Resume PickOnAnotherDatabase

End Sub

' 1st Sub:

Sub GetRunParameters (TargetServer As String, OldServer As String, NewServer As String)

'Ask the user to enter three parameters. One is the target server to be
'searched. Another is the old server name to look for in each agent's "run on
'server" setting. The third parameter might be the new server name to be plugged
'in as the new "run on server" setting, replacing the old server name. One
'question -- Will this third parameter generally be the same as the first
'parameter (target server)?

Set Session = New NotesSession
Set CurrentDb = Session.CurrentDatabase
Let TargetServer = Inputbox$ ("Enter the name of the target server.", "", CurrentDb.Server)
If TargetServer = "" Then End

Let OldServer = Inputbox$ ("Enter the old server name to look for in each agent's run-on-server setting. "& _
"This can be the 'common' form of the server name and the script will check if the string value of the "& _
"current run-on-server setting 'contains' the specified name")
If OldServer = "" Then End

Let NewServer = Inputbox$ ("Enter the new server name to be plugged in as the new run-on-server setting. "& _
"This may generally be the same as the target server. *** Does this need to be in canonical form?", "", TargetServer)
If NewServer = "" Then End

End Sub

'2nd Sub:

Sub DoConfirmationPrompt (Prompt As String)

' Announce the purpose of this "action" and prompt the user for confirmation before continuing.
Dim answer As Integer
Let answer = Msgbox (Prompt &" Do you want to continue?", 1+32+256, "CONFIRMATION PROMPT")
If answer <> 1 Then End

End Sub

'3rd Sub:

' Create new log record, filling in RunDate, AdminScriptRunner & TargetServer fields

Set LogRecord = New NotesDocument (CurrentDb)

With LogRecord
Let .Form = "Log"
Let .RunDate = Now
Let .AdminScriptRunner = Session.UserName
Let .TargetServer = TargetServer

'Record the run parameters entered by user into the log for posterity
Let .LogResults = "For this operation, the old server name "& _
"to look for was specified as "& OldServer & Chr$(10) &"while the new "& _
"server name to be plugged in was entered as "& NewServer & _
Chr$(10) & Chr$(10)

' Then save the new log record
.Save True, True, True
End With

End Sub

'4th Sub:

' Create new log record, filling in RunDate, AdminScriptRunner & TargetServer fields

Set LogRecord = New NotesDocument (CurrentDb)

With LogRecord
Let .Form = "Log"
Let .RunDate = Now
Let .AdminScriptRunner = Session.UserName
Let .TargetServer = TargetServer

'Record the run parameters entered by user into the log for posterity
Let .LogResults = "For this operation, the old server name "& _
"to look for was specified as "& OldServer & Chr$(10) &"while the new "& _
"server name to be plugged in was entered as "& NewServer & _
Chr$(10) & Chr$(10)

' Then save the new log record
.Save True, True, True
End With

End Sub

'5th Sub:

' Report or record somewhere that this particular database was updated.
' Add to the log record the name and path of the database

With LogRecord
Let .LogResults = .LogResults(0) & Message & Chr$(10)

' Then save the new log record
.Save True, True, True
End With

End Sub

'6th Sub:

Function IsSystemTypeDatabase (dbFilePath As String) As Integer

'Skip any dbs that exist in any of the "system" folders

If Instr (dbFilePath,"\") = 0 _
Or Ucase$ (Left$ (dbFilePath,4)) = "DOC\" _
Or Ucase$ (Left$ (dbFilePath,7)) = "DOMINO\" _
Or Ucase$ (Left$ (dbFilePath,8)) = "GTRHOME\" _
Or Ucase$ (Left$ (dbFilePath,5)) = "HELP\" _
Or Ucase$ (Left$ (dbFilePath,7)) = "INOTES\" _
Or Ucase$ (Left$ (dbFilePath,5)) = "MAIL\" _
Or Ucase$ (Left$ (dbFilePath,7)) = "MODEMS\" _
Then



Let IsSystemTypeDatabase = True
Else
Let IsSystemTypeDatabase = False
End If

End Function