Replace database design on selected people in address book
Replace database design on selected people in address book
This Lotus script agent is to be created in the address book. By selecting people from the address book, you can replace their database design template with anyone template that you choose. The script will not immediately replace the design, it will only update the template that it inherits its design from. The design will be replaced next time the servers "designer" task executes, or you may optionally immediately start the designer task by issuing the command "load design" at the each of the servers console in question.
The basic operation of this script is as follows:
1. Counts the number of documents to process and prompts if you want to continue.
2. You are prompted to enter the design template name to replace on the selected persons mail files, this must be the full template name ie. StdR46Mail, StdR50Mail, or StdR46ComboMail, etc, etc. DO NOT enter the filename of the template (such as mail46.ntf). The script will not validate this entry.
3. You can optionally choose to replace the design template of the selected peoples mail files, if the current template matches the design of the template(s) that you choose here. You may enter as many design template names as you wish, seperated by spaces, such as: StdR45Mail StdR46Mail StdR46ComboMail
eg. You selected 100 people from the address book. Assume 50 of these persons' mail files were using the StdR46Mail template, 25 of these mail files was StdR45Mail and the other 25 was StdR46Web. You choose the new template StdR46Mail at (2), and you choose at (3) StdR45Mail, then after completion, the only databases that will have their design template changed to StdR46Mail will be the 25 StdR45Mail, resulting in the following: 75 mail files will be StdR46Mail and 25 mail files will be StdR46Web.
4. All of the selected people from the address book are read into an array. The following three components of the person information are stored in the array: Mail Server, User Name and Mail File
5. The array is then sorted by a simple case insensitive ascending bubble sort on the server name, resulting in all mail files being grouped together by their mail server.
6. Each entry of the sorted array is read in turn and does the following on each entry:
7. Opens the database, reads the database information buffer and extracts the current design template, checks the template name if it matches the criteria entered at (3) above (if applicable), then modifies the information buffer with the new template name, then writes the information buffer back to the database. The database icon note is then opened, the modified information buffer is then written to the field $TITLE of the icon note, then the note is then saved. The database is then closed and loops back to (6) until all databases are processed.
8. After completion, displays a message box with the results.
All results are printed to the status bar and it also writes results to two files:
c:\Replace_Design_Success.txt (all successful transactions) c:\Replace_Design_Error.txt (all unsuccessful transactions with any API error codes)
You can select as many documents from the address book as you like, however, since field in each person document is appended to an array, there will be a limit on the number of documents you can process. This is due to the memory size limits within Lotus Script to handle arrays. Since all documents are read into an array prior to processing, there is no harm in testing approx how many documents you can process at once.
Due to space restrictions, all comments within the code were removed, however, you may download the complete code listing from:
www.users.bigpond.com/dfry/downloads/Replace_Design.txt
Any problems, contact me at noteshelp@bigpond.com
Dennis Fry
AGENT PROPERTIES
1. Create a new shared agent in the address book
2. When: Manually from Actions Menu
3. Which document(s): Selected documents
4. Script agent
Copy and paste the code below into the script agent, then select the people from the people view, then select this agent from the Actions menu to replace the design of the selected persons mail files. Then wait for the designer task to run or type: load design (on each of the servers)
Option Public
Option Explicit
(Declarations)
Const SuccessLog = "c:\Replace_Design_Success.txt"
Const ErrorLog = "c:\Replace_Design_Error.txt"
Public Const INFOPARSE_DESIGN_CLASS = 3
Public Const NSF_INFO_SIZE = 128
Const MAXWORD = &hFFFF
Const FIELD_TITLE = "$TITLE"
Const NOTE_CLASS_ICON = &h0010
Const SPECIAL_ID_NOTE = &h8000
Public rc As Integer
Declare Function W32_NSFDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" (Byval PathName As String, rethDB As Long) As Integer
Declare Function W32_NSFDbClose Lib "nnotes.dll" Alias "NSFDbClose" (Byval hDB As Long) As Integer
Declare Function W32_NSFDbInfoGet Lib "nnotes.dll" Alias "NSFDbInfoGet" (Byval hDB As Long, Byval retBuffer As String) As Integer
Declare Function W32_NSFDbInfoSet Lib "nnotes.dll" Alias "NSFDbInfoSet" (Byval hDB As Long, Byval Buffer As String) As Integer
Declare Sub W32_NSFDbInfoModify Lib "nnotes.dll" Alias "NSFDbInfoModify" (Byval Info As String, Byval What As Integer, Byval Buffer As String)
Declare Sub W32_NSFDbInfoParse Lib "nnotes.dll" Alias "NSFDbInfoParse" (Byval Info As String, Byval What As Integer, Byval Buffer As String, Length As Integer)
Declare Function W32_NSFNoteOpen Lib "nnotes.dll" Alias "NSFNoteOpen" (Byval hDb As Long, Byval NoteID As Long, Byval OpenFlags As Integer, rethNote As Long) As Integer
Declare Function W32_NSFNoteClose Lib "nnotes.dll" Alias "NSFNoteClose" (Byval hNote As Long) As Integer
Declare Function W32_NSFNoteUpdate Lib "nnotes.dll" Alias "NSFNoteUpdate" (Byval hNote As Long, Byval UpdateFlags As Integer) As Integer
Declare Function W32_NSFItemSetText Lib "nnotes.dll" Alias "NSFItemSetText" (Byval hNote As Long, Byval ItemName As String, Byval Text As String, Byval TextLength As Integer) As Integer
Sub Initialize
Dim session As NotesSession
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Dim nnUser As NotesName
Dim nnServer As NotesName
Dim TempEntry As String
Dim Msg As String
Dim MailFile As String
Dim Databases() As String
Dim NumDatabases As Integer
Dim Answer As Integer
Dim NewTemplate As String
Dim OldTemplate As String
Dim Templates As String
Dim hDB As Long
Dim szInfoBuffer As String * NSF_INFO_SIZE
Dim NumSuccess As Integer
Dim NumUnsuccess As Integer
Set session = New NotesSession
Set db = session.CurrentDatabase
Set dc = db.UnprocessedDocuments
If dc.Count = 0 Then
Msgbox "There are no documents selected",,"Error"
End
End If
Answer = Msgbox("You are about to replace the design template on " & dc.Count & " databases." & Chr$(13) & Chr$(13) & _
"Do you want to continue?", 4, "Replace Design Template")
If Answer = 7 Then
Print "Aborted...."
End
End If
NewTemplate = Inputbox("Enter the new design template name", "Design Templates", "StdR46Mail")
If NewTemplate = "" Then
Print "Aborted...."
End
End If
Templates = ""
Answer = Msgbox("Do you only want to replace the design on databases that has a particular design template?", 4, "Replace Design on some Databases")
If Answer = 6 Then
Templates = Inputbox("Enter the design template(s) on databases you wish to have replaced, seperated by spaces","Design Templates", "StdR45Mail StdR46Mail StdR46ComboMail")
Templates = Ucase(Templates)
If Templates = "" Then
Print "Aborted...."
End
End If
End If
Open SuccessLog For Output As #1
Open ErrorLog For Output As #2
NumDatabases = 0
NumSuccess = 0
NumUnsuccess = 0
Set doc = dc.GetFirstDocument
While Not doc Is Nothing
Set nnUser = New NotesName(doc.FullName(0))
Set nnServer = New NotesName(doc.MailServer(0))
MailFile = Trim$(doc.MailFile(0))
If nnServer.Abbreviated = "" Or MailFile = "" Then
NumUnSuccess = NumUnSuccess + 1
Msg = "Invalid Server or MailFile for " & nnUser.Abbreviated
Print Msg
Print #2, Msg
Else
Redim Preserve Databases(NumDatabases)
Databases(NumDatabases) = nnServer.Abbreviated & "!!" & nnUser.Abbreviated & "!!" & MailFile
NumDatabases = NumDatabases + 1
End If
Set doc = dc.GetNextDocument(doc)
Wend
Call BubbleSort(Databases())
Forall Entry In Databases
TempEntry = Entry
Set nnServer = New NotesName(Left$(TempEntry, Instr(TempEntry, "!!") -1))
TempEntry = Right$(TempEntry, Len(TempEntry) - Instr(TempEntry, "!!") - 1)
Set nnUser = New NotesName(Left$(TempEntry, Instr(TempEntry, "!!") -1))
TempEntry = Right$(TempEntry, Len(TempEntry) - Instr(TempEntry, "!!") - 1)
MailFile = TempEntry
hDB = 0
rc = W32_NSFDbOpen(nnServer.Abbreviated & "!!" & MailFile, hDB)
If rc <> 0 Then
NumUnSuccess = NumUnSuccess + 1
Msg = "Error " & rc & " - Unable to open database " & MailFile & " (" & nnUser.Abbreviated & ")"
Print Msg
Print #2, Msg
Goto GetNextDatabase
End If
OldTemplate = ""
If (UpdateDatabaseInfo(hDB, szInfoBuffer, MailFile, NewTemplate, Templates, OldTemplate, Msg)) Then
NumUnSuccess = NumUnSuccess + 1
Print Msg
Print #2, Msg
Goto FinishReplaceDesign
End If
If (UpdateDatabaseIconNote(hDB, szInfoBuffer, MailFile, Msg)) Then
Print Msg
Print #2, Msg
Goto FinishReplaceDesign
End If
NumSuccess = NumSuccess + 1
Msg = "Completed " & nnServer.Abbreviated & " " & MailFile & " (" & nnUser.Abbreviated & ") " & OldTemplate & " -> " & NewTemplate
Print #1, Msg
FinishReplaceDesign:
If hDB <> 0 Then
W32_NSFDbClose(hDB)
End If
GetNextDatabase:
End Forall
Close #1
Close #2
Msg = "Replace design results:" & Chr$(13) & Chr$(13)
Msg = Msg & "Successful: " & NumSuccess & Chr$(13)
Msg = Msg & "Unsuccessful: " & NumUnSuccess & Chr$(13) & Chr$(13)
Msg = Msg & "Check the output files for the results" & Chr$(13) & Chr$(13)
Msg = Msg & "The databases design on successful databases will not occur until the servers design task is executed," & Chr$(13)
Msg = Msg & "you may optionally start the design task immediately by issuing the following command on each server:" & Chr$(13) & Chr$(13)
Msg = Msg &"load design" & Chr$(13) & Chr$(13)
Msg = Msg &"Warning: It is not recommended to issue the above command if the affected users are accessing their mail files!!"
Msgbox Msg,,"Completed"
End Sub
Function BubbleSort(Databases() As String)
Dim NumElements As Integer
Dim Count1 As Integer
Dim Count2 As Integer
Dim Temp As String
NumElements = Ubound(Databases)
If NumElements < 1 Then Exit Function
For Count1 = 0 To NumElements
For Count2 = 0 To NumElements - 1
If Lcase(Databases(Count2)) > Lcase(Databases(Count2 + 1)) Then
Temp = Databases(Count2)
Databases(Count2) = Databases(Count2 + 1)
Databases(Count2 + 1) = Temp
End If
Next
Next
End Function
Function UpdateDatabaseInfo(hDB As Long, szInfoBuffer As String, MailFile As String, NewTemplate As String, Templates As String, OldTemplate As String, ErrorMsg As String) As Variant
Dim szRetVal As String * NSF_INFO_SIZE 'storage for the current databases design template
UpdateDatabaseInfo = False 'false = no error, true = exit with error
szInfoBuffer = String(NSF_INFO_SIZE,0)
rc = W32_NSFDbInfoGet(hDB, szInfoBuffer)
If rc <> 0 Then
UpdateDatabaseInfo = True
ErrorMsg = "Error " & rc & " - Unable to get database information buffer for " & MailFile
Exit Function
End If
szRetVal = String(NSF_INFO_SIZE,0)
Call W32_NSFDbInfoParse (szInfoBuffer, INFOPARSE_DESIGN_CLASS, szRetVal, NSF_INFO_SIZE -1)
OldTemplate = Left(szRetVal,Instr(szRetVal,Chr(0))-1)
If ((Templates = "") Or (Instr(Templates, Ucase(OldTemplate)) > 0)) Then
Call W32_NSFDbInfoModify(szInfoBuffer, INFOPARSE_DESIGN_CLASS, NewTemplate)
rc = W32_NSFDbInfoSet(hDB,szInfoBuffer)
If rc <> 0 Then
UpdateDatabaseInfo = True
ErrorMsg = "Error " & rc & " - Unable to set new database template for " & MailFile
Exit Function
End If
Else
UpdateDatabaseInfo = True
ErrorMsg = "Database template (" & OldTemplate & ") for " & MailFile & " was not replaced with " & NewTemplate
Exit Function
End If
End Function
Function UpdateDatabaseIconNote(hDB As Long, szInfoBuffer As String, MailFile As String, ErrorMsg As String) As Variant
Dim hIconNote As Long
UpdateDatabaseIconNote = False 'false = no error, true = exit with error
hIconNote = 0
rc = W32_NSFNoteOpen(hDb, SPECIAL_ID_NOTE + NOTE_CLASS_ICON, 0, hIconNote)
If rc <> 0 Then
UpdateDatabaseIconNote = True
ErrorMsg = "Unable to open database icon note in " & MailFile
Exit Function
End If
rc = W32_NSFItemSetText(hIconNote, FIELD_TITLE, szInfoBuffer, MAXWORD)
rc = W32_NSFNoteUpdate(hIconNote, Int(0))
FinishFunction:
If hIconNote <> 0 Then
W32_NSFNoteClose(hIconNote)
End If
End Function
Start the conversation
0 comments