拷贝指定数据库所有文档到当前数据库中

'功能：拷贝指定数据库所有文档到当前数据库中
'步骤：
'1 在当前数据库创建代理CopyOldData，代理代码见文后。
'2 在当前数据库某个表单或视图创建一个操作，该操作执行CopyOldData代理。
'3 使用服务器身份对数据库签名。
'4 IE进入步骤2中的表单或视图，点击操作执行代理。
'5 执行完成后，系统后台会提示拷贝的文档数量
'6 操作完成请删除或隐藏增加的操作和代理。
'注意事项：
'1 代理中的源数据库路径需根据实际情况修改。
'2 源数据库中必须存在能够显示所有文档的视图All。
'3 服务器必须对源数据库有读权限，对目标数据库有写权限。
'4 代理运行时间根据数据库文档数量而定。

'CopyOldData:

Option Public
Option Declare

Sub Initialize
On Error Goto ErrHandle
Dim ss As New NotesSession
Dim db As NotesDatabase
Dim dbSource As NotesDatabase
Set db=ss.CurrentDatabase
Set dbSource=ss.GetDatabase("","oa/db.nsf")
If Not(dbSource.IsOpen) Then
Msgbox "无法打开数据库！"
Exit Sub
End If
CopyAllData dbSource,db
Exit Sub
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Sub

Sub CopyAllData(dbSource As NotesDatabase,dbTarget As NotesDatabase)
'拷贝源数据库中所有文档到目标数据库
On Error Goto ErrHandle
Dim doc As NotesDocument
Dim docNew As NotesDocument
Dim view As NotesView

Set view=dbSource.GetView("All")
Set doc=view.GetFirstDocument
While Not(doc Is Nothing)
Set docNew = New NotesDocument(dbTarget)
Call doc.CopyAllItems(docNew,True)
docNew.UniversalID = doc.UniversalID
Call docNew.Save(True,True)
Set doc=view.GetNextDocument(doc)
Wend
Msgbox "CopyAllData=" & view.EntryCount
Exit Sub
ErrHandle:
Msgbox "Error:" & Err & " Erl:" & Erl
End Sub