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

'功能：拷贝指定数据库所有文档到当前数据库中
'步骤：
' 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