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