LS把邮件数据库中的所有文档和文件夹复制到另一个数据库中

Technote (troubleshooting)

问题
当您需要建立一个新的邮件（或归档）数据库时，需要将旧数据库中的所有文档和文件夹复制并粘贴到新的数据库中。这是很浪费时间的，而且本地机器可能没办法把如此大量的数据都复制到操作系统的剪贴板中。还能通过什么方式来完成这个操作呢？
解决问题

可以通过使用LotusScript代理来实现这个操作.

以下是一个代理示例，它可以把一个邮件/归档数据库中的所有文档复制到另一个数据库中。它会提示用户输入一个源数据库和一个目标数据库。也就是说，这个代理可以在任何一个数据库中被创建和运行。代理会遍历源数据库中的所有文件夹，并且会把所有文件夹和文件夹中的文档复制到目标数据库。遍历文件夹之后，代码还将拷贝所有剩余的文档。注意：代码不会复制以下文件夹：废纸篓，警告，规则，群组日历。这个代理的运行目标应该设置为空(None)。由于这个例子是基于LotusScript的，它的运行属性必须设置为LotusScript（而不是公式或简单操作等）。

注意：这个代理的运行目标应该设置为“空”(None)，这个参数在新的代理中默认为“所有被选中的文档”。

这段代码使用“所有文档”视图的选择公式来收集所有文档 -
"@IsNotMember(""A""; ExcludeFromView) & IsMailStationery != 1" + _
"& Form != ""Group"" & Form != ""Person""".
如果您想使用其他的选择公式，修改字符串AllDocsSelect的值就可以。

特别注意：下面是一个实例脚本，仅是一个解决此问题的方式之一。IBM Lotus支持团队不会为特定客户配置来定制这段脚本。然而这个例子对很多客户来说是很有用的，提供此例仅作为一个建议，IBM Lotus不会提供进一步的支持。

Dim s As New NotesSession
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

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, _
"Please 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")
sourceDbName = Inputbox("Enter the filename of the database relative to the server data directory")
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
destDbServer = Inputbox("Enter the name of the Domino server")
destDbName = Inputbox("Enter the filename of the database relative to the server data directory")
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.")

由于此技术文档存在折行问题，下面的附件是一个包含这个代理代码的文本文件（COPYDOC.TXT）。建议把文本文件中的代码复制和粘贴到代理的Initialize子程序中。