Leadership By Numbers

Category Administration
Recently a junior admin made a configuration mistake in an Archive Setting document which created new sets of archive databases. New archives were being created with new filenames, and now the clients had two mail archives which needed to be knit back together. Apparently, this hasn't been the first occasion for this error as there is an IBM Technote on copying documents between databases.

The technote includes the LotusScript for moving documents from one mail file into another, and it's a fairly handy little utility. I wanted to hand it over to the admin, but as I looked at it, I realized that it was missing something very simple. All the input was accomplished by entering static text: the name of the server(s), the source database and the target database.

If this code is intended to address the consequence of someone's mistake, then I think it only fair to assume that it should accept that the same thinking which made the mistake might occur again. So, I added a lookup for all the databases on whichever server is being chosen. It's a quick addition, but I think it makes all the difference, and I'm much more confident that the correct database will be chosen.

 

 

 

'copyfiles:

Option Public

Option Declare

Dim dbdir As NotesDbDirectory

Dim svrdb As NotesDatabase

Dim s As NotesSession

Dim filelist() As String

 

Sub Initialize

 

Dim w As New NotesUIWorkspace

Dim destDb As New NotesDatabase("","")

Dim sourceDb As New NotesDatabase("","")

Dim AllDocs As NotesDocumentCollection

Dim AllDocsView As NotesView

Dim sourceDoc As NotesDocument

Dim destDoc As NotesDocument

Dim tempDoc As NotesDocument

Dim docCount As Variant

Dim current As Variant

Dim choices (0 To 2) As Variant

 

Dim sourceDbType As Variant

Dim sourceDbServer As Variant

Dim sourceDbNameReturn As Variant

Dim sourceDbName As Variant

Dim destDbType As Variant

Dim destDbServer As Variant

Dim destDbNameReturn As Variant

Dim destDbName As Variant

Dim destFolder As Variant

Dim AllDocsSelect As Variant

Dim sourceFolder As Variant

 

 

Set s = New NotesSession

 

 

choices(0) = "Current Database"

choices(1) = "Local Database"

choices(2) = "Database on Server"

 

 

' get source database

sourceDbType = w.Prompt(PROMPT_OKCANCELLIST, "Select Database Location", _

"Select the location of the database you would like to copy from:", _

choices(0), choices)

 

If sourceDbType = "" Then

Messagebox "Operation cancelled"

Exit Sub

End If

 

If sourceDbType = choices(0) Then

Set sourceDb = s.CurrentDatabase

Else

If sourceDbType = choices(1) Then

sourceDbServer = ""

sourceDbNameReturn = w.OpenFileDialog(False, _

"Select the database you would like to copy from", "*.nsf", _

s.GetEnvironmentString("Directory", True))

If Isempty(sourceDbNameReturn) Then 'Means they hit Cancel

Msgbox("Operation cancelled: Unable to continue without a filename.")

Exit Sub

End If

sourceDbName=SourceDbNameReturn(0)

Else

sourceDbServer = Inputbox("Enter the name of the Domino server")

 

'putting in the source database from a server list of databases

 

Call getdbdirlist(sourceDbServer)

 

sourceDbName = w.Prompt (PROMPT_OKCANCELLIST, "Select a Database", "Select a database to open.", "", filelist)

 

If sourceDbName = "" Then

Msgbox("Operation cancelled: Unable to continue without a filename.")

Exit Sub

End If

End If

If Not (sourceDb.Open(sourceDbServer, sourceDbName)) Then

Msgbox("Unable to find/open file: " + sourceDbName)

Exit Sub

End If

End If

 

' get destination database

destDbType = w.Prompt(PROMPT_OKCANCELLIST, "Destination Database", _

"Select the location of the database you would like to copy documents/folders to", _

choices(1), choices)

 

If destDbType = "" Then

Messagebox "Operation cancelled"

Exit Sub

End If

If destDbType = choices(0) Then

Set destDb = s.CurrentDatabase

Else

If destDbType = choices(1) Then

destDbServer = ""

destDbNameReturn = w.OpenFileDialog(False, _

"Please select the database you would like to copy from", "*.nsf", _

s.GetEnvironmentString("Directory", True))

If Isempty(destDbNameReturn) Then 'Means they hit Cancel

Msgbox("Operation cancelled: Unable to continue without a filename.")

Exit Sub

End If

destDbName=destDbNameReturn(0)

Else

 

'putting in the destination database from a server list of databases

 

 

destDbServer = Inputbox("Enter the name of the Domino server")

 

Call getdbdirlist(destDbServer)

 

destDbName = w.Prompt (PROMPT_OKCANCELLIST, "Select a Database", "Select a database to write to.", "", filelist)

 

If destDbName = "" Then

Msgbox("Operation cancelled: Unable to continue without a filename.")

Exit Sub

End If

End If

If Not (destDb.Open(destDbServer,destDbName)) Then

Msgbox("Unable to find/open file: " + destDbName)

Exit Sub

End If

End If

 

If destdb.server=sourcedb.server And destdb.filename=sourcedb.filename And destdb.filepath=sourcedb.filepath Then

Msgbox("Source and Destination database should not be the same database")

Exit Sub

End If

 

' Build collection of all documents in source database using selection

' formula similar to that used in the Mail templates All Documents view

AllDocsSelect = "@IsNotMember(""A""; ExcludeFromView) & IsMailStationery != 1" + _

"& Form != ""Group"" & Form != ""Person"""

Set AllDocs = sourceDb.Search(AllDocsSelect, Nothing, 0)

 

' display progress

docCount = AllDocs.Count

current = 0

Print Cstr(Round(current / docCount * 100, 0)) + "% copied"

 

' step through each folder in source database except system folders other than Inbox

Forall folder In sourceDb.Views

If folder.IsFolder And (Instr(1, folder.Name, "(", 0)<>1 Or folder.Name="($Inbox)") Then

 

' The following code ensures that folders with no docs in them still get copied

' so that any folder design customizations are kept

Set destFolder = destDb.GetView(folder.Name)

If destFolder Is Nothing Then

Set sourceFolder = sourceDb.GetDocumentByUNID(folder.UniversalID)

Call sourceFolder.CopyToDatabase(destDb)

Set destFolder = destDb.GetView(folder.Name)

If destFolder Is Nothing Then

Msgbox("Unable to create folder in new database.")

Exit Sub

End If

End If

' cycle through each doc in the current folder

Set sourceDoc = folder.GetFirstDocument

While Not (sourceDoc Is Nothing)

Set destDoc = sourceDoc.CopyToDatabase(destDb)

' copy each document to the same folder in the destination database

Call destDoc.PutInFolder(folder.Name, True)

' remove document from the collection of docs built from source db all docs view

Set tempDoc = AllDocs.GetDocument(sourceDoc)

Set sourceDoc = folder.GetNextDocument(tempDoc)

Call AllDocs.DeleteDocument(tempDoc) 'remove from collection

' display progress

current = current + 1

Print Cstr(Round(current / docCount * 100, 0)) + "% copied"

Wend

End If

End Forall

 

' docs remaining in collection are not in any folder - copy these to dest. db

Set sourceDoc = AllDocs.GetFirstDocument

While Not (sourceDoc Is Nothing)

Call sourceDoc.CopyToDatabase(destDb)

' display progress

current = current + 1

Print Cstr(Round(current / docCount * 100, 0)) + "% copied"

Set sourceDoc = AllDocs.GetNextDocument(sourceDoc)

Wend

'done

Msgbox("Documents have been copied. Close and reopen the destination file (if it is open) so that it can be refreshed.")

End Sub

Function getdbdirlist(server)

Set dbdir = s.GetDbDirectory(server)

Set svrdb = dbdir.GetFirstDatabase(DATABASE)

 

 

Set svrdb = dbdir.GetFirstDatabase(DATABASE)

Dim count As Long

count = 0

 

While Not(svrdb Is Nothing)

 

Redim Preserve filelist(count)

filelist(count) = svrdb.FilePath

count = count +1

Set svrdb = dbdir.GetNextDatabase

Wend

 

'dbdir is a summary of the database, the sort of data found in the infobox, but it doesn't actually open the database

End Function