OA开发中经常要搭建测试环境,测试环境的数据库与原数据库不能有ID冲突现象,以防混淆。以下是一个批量修改数据库标识符的方法,其中,取得这些需要更改的数据库,需要导出源服务器上的数据库路径和名称,方法详见我的博文:LotusScript_导出数据库路径和名称
Sub Initialize Const 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(1) '打开EXCEL工作表 xlsheet.Activate '激活工作表 i=2 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+1 Wend End Sub