LotusScript_导出数据库路径和名称

对服务器有些数据库需要建立复本，新建拷贝，修改权限（ACL），或是修改数据库标识符（ID）需要找到这些数据库。这个方法是导出指定服务器上所有数据库的路径，数据库名，标识符等信息，导出后对Excel表格进行筛选，即可对筛选出的数据库进行后续操作。

Sub Initialize
Const SourceSever = "xxx.xxx.xxx.xxx"    '源服务器
Const ExcelSavePath = "C:\ResetReplicaID.xls"

Dim s As New NotesSession
    Dim dbdir As New NotesDbDirectory(SourceSever)
    Dim db As NotesDatabase
    Dim view As NotesView
    Dim doc As NotesDocument
    
    Dim excelApplication As Variant
    Dim excelWorkbook As Variant
    Dim excelSheet As Variant
    Dim i,index1,index2 As Integer
    
    Set excelApplication = CreateObject("Excel.Application")       '创建Excel对象
    excelApplication.Visible = True '显示Excel
    Set excelWorkbook = excelApplication.Workbooks.Add '添加表
    Set excelSheet = excelWorkbook.Worksheets("Sheet1") '选中表
    
    Set db =dbdir.GetFirstDatabase(DATABASE)
    
'第1行写标题
    excelSheet.Cells(1,1).Value = "DbFile"
    excelSheet.Cells(1,2).Value = "DbTitle"
    excelSheet.Cells(1,3).Value = "DbPath"
    excelSheet.Cells(1,4).Value = "DbName"
    excelSheet.Cells(1,5).Value = "ReplicaID"
    
'从第2行开始写数据
    i = 2
    While Not(db Is Nothing)
        excelSheet.Cells(i,1).Value = db.FilePath
        excelSheet.Cells(i,2).Value = db.Title
        excelSheet.Cells(i,3).Value =     Left(db.FilePath,Len(db.FilePath)-Len(db.FileName))
        excelSheet.Cells(i,4).Value = Left(db.FileName,Len(db.FileName)-4)
        excelSheet.Cells(i,5).Value = db.ReplicaID
        i = i+1
        Set db = dbdir.GetNextdatabase
    Wend
    
    excelWorkbook.SaveAs(ExcelSavePath)
    excelApplication.Quit
    Set excelApplication = Nothing
    Messagebox("文件已保存")
End Sub