LotusScript_批量更改数据库标识符（id）

Sub InitializeConst SourceServer = "xxx.xxx.xxx.xxx" 'NSF源服务器
Const TargetServer = "xxx.xxx.xxx.xxx" 'NTF中转服务器
Const TargetServer2 = "xxx.xxx.xxx.xxx" 'NSF目标服务器
Const FilePath= "C:\ResetReplicaID.xls" ’待修改的数据库路径Dim s As New NotesSession
Dim db As NotesDatabase
Dim template As NotesDatabase '模版名称，需要在源服务器建立模版
Dim brandNewDb As NotesDatabase '新建数据库
Dim replica As NotesDatabase '复本数据库 Dim xlApp As Variant
Dim xlBook As Variant
Dim xlsheet As Variant
Dim i As Integer Dim DbFile As String 'A:数据库路径名, ex: oa\Attendance.nsf
Dim DbTitle As String 'B:数据库标题, ex:考勤管理
Dim DbPath As String 'C:路径, ex: oa\
Dim DbName As String 'D:数据库文件名，不带后缀, ex: Attendance Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(FilePath)
xlApp.Visible=True
Set xlsheet = xlBook.Worksheets() '打开EXCEL工作表
xlsheet.Activate '激活工作表 i=
While Trim(xlsheet.Range("A"+Trim(Str(i))).Value)<>"" DbFile = Trim(xlsheet.Range("A"+Trim(Str(i))).Value)
DbTitle = Trim(xlsheet.Range("B"+Trim(Str(i))).Value)
DbPath = Trim(xlsheet.Range("C"+Trim(Str(i))).Value)
DbName = Trim(xlsheet.Range("D"+Trim(Str(i))).Value) Set db = s.GetDatabase(SourceServer, DbFile, False) If Not db Is Nothing Then
Set replica =db.CreateReplica(TargetServer, "TEST\"+DbPath+DbName+".ntf")
replica.Title=DbTitle
Set template = s.GetDatabase(TargetServer, "TEST\"+DbPath+DbName+".ntf")
If Not template Is Nothing Then
'Call db.Remove'=========Warning========在源服务器上移除源数据库
Set brandNewDb =template.CreateFromTemplate(TargetServer2, DbFile, False)
brandNewDb.Title = DbTitle
End If
Else
Msgbox "Can't open the database"+SourceServer+":"+DbFile+"!"
End If
Print "No."+Str(i)+"——"+SourceServer+" : "+DbFile+"已经成功!"
i=i+
Wend
End Sub