Issue:
Have a cluster mail server down and need to move everyone to another backup w/o doing.
Solution Part A:
The agent below runs on selected users in the Mail Users view (where you select users under the category of the "old" server).
IMPORTANT NOTE:
This is NOT a mail move. Don't use this utility as a replacement for the mail move tool.
Sub Initialize
Dim s As New NotesSession
Dim w As New NotesUIWorkspace ' prompt
Dim db As NotesDatabase ' current db
Dim svnm As String ' server lookup view name
Dim sV As NotesView ' server lookup view
Dim pCol As NotesDocumentCollection ' person docs selected
Dim pDoc As NotesDocument ' current person doc being processed
Dim pNxtDoc As NotesDocument ' next doc after pDoc
Dim askme As Variant ' prompt results
Dim servernm As String ' name of askme
' setup
svnm = "($Servers)"
Set db = S.CurrentDatabase
Set sV = db.GetView(svnm)
Set pCol = db.UnprocessedDocuments
If (pCol.Count = 0) Then
Print "Nothing selected. Done."
Exit Sub
End If
If (sV Is Nothing) Then
' give up
Print "Missing server lookup view."
Exit Sub
End If
askme = w.PickListStrings( PICKLIST_CUSTOM, False, db.Server, db.FilePath, svnm, _
"Server Selection", "Select the new home server.", 1 )
servernm = Cstr(askme(0))
If (servernm = "") Then
' cancel out
Print "No server selected."
Exit Sub
End If
Set pDoc = pCol.GetFirstDocument()
While Not (pDoc Is Nothing)
' next doc
Set pNxtDoc = pCol.GetNextDocument(pDoc)
Call pDoc.ReplaceItemValue("MailServer", servernm)
Call pDoc.Save(True, False)
' next
Set pDoc = pNxtDoc
Wend
Print "Done."
End Sub
______________________________________________
Solution Part B:
The agent below recreates the original replica back on the home server that was lost. You select the people and then run the code, then you select the target server and it tries to create the replicas.
IMPORTANT NOTES:
This is NOT a mail move. Don't use this utility as a replacement for the mail move tool.
Creating replicas is time consuming. Test this on one user. When run in production, watch first person's replica be created and let run overnight.
Option Public
Option Declare
Sub Initialize
Dim w As New NotesUIWorkspace
Dim svrpick As Variant
Dim s As New NotesSession
Dim db As NotesDatabase ' names.nsf
Dim pDoc As NotesDocument ' person doc
Dim pCol As NotesDocumentCollection ' selected docs in view
Dim targetsvr As String ' target server for replica
On Error Goto ErrorHandler
' setup
Set db = s.CurrentDatabase
Set pCol = db.UnprocessedDocuments
' get target server
svrpick = w.PickListStrings( PICKLIST_CUSTOM, False, db.Server, "names.nsf", "($Servers)", "Target Server", _
"Please the target server for this operation.", 1)
If (Isempty(svrpick)) Then
' abort
Print "Cancelled by user. Done."
Exit Sub
End If
targetsvr = Cstr(svrpick(0))
If (targetsvr="") Then
' abort
Exit Sub
End If
' process selected docs
Set pDoc = pCol.GetFirstDocument
While Not (pDoc Is Nothing)
' loop through person docs, creating new mail files
Call ProcessPerson(s, db, pDoc, targetsvr)
Set pDoc = pCol.GetNextDocument(pDoc)
Wend
Print "Done"
Exit Sub
ErrorHandler:
Print "(Initialize) Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & "."
Exit Sub
End Sub
Function ProcessPerson(s As NotesSession, db As NotesDatabase, pDoc As Notesdocument, targetsvr As String) As Integer
' pDoc - select person getting processed now
' targetsvr - destination for new replica
Dim mailsvr As String
Dim mailpath As String
Dim pDb As NotesDatabase ' current person's mail file
Dim nDb As NotesDatabase ' new mail file
Dim profileDoc As NotesDocument ' preferences profile w/ owner
On Error Goto FErrorHandler
' get mail values from person doc
mailsvr = pDoc.MailServer(0)
mailpath = pDoc.MailFile(0)
Set pDb = s.GetDatabase(mailsvr, mailpath, False)
If (pDb Is Nothing) Then
' give up
ProcessPerson = 0
Exit Function
End If
If Not (pDb.IsOpen) Then
Call pDb.Open(mailsvr, mailpath) ' this will go to errorhandler most likely if insufficient acl
If Not (pDb.IsOpen) Then
' give up
ProcessPerson = 0
Exit Function
End If
End If
' have current replica, create new replica on target server
Set nDb = pDb.CreateReplica(targetsvr, mailpath)
' done
ProcessPerson = 1
FExit:
Exit Function
FErrorHandler:
Print "(Initialize) Error: " & Cstr(Err) & " " & Error$ & ", on line: " & Cstr(Erl) & "."
Resume FExit
End Function
previous page
|