[LotusScript] 匯出指定Server下的所有資料庫資訊

1  (Declarations)
Const xlTop = -4160
Const xlCenter = -4108
Const xlEdgeLeft = 7
Const xlEdgeTop = 8
Const xlEdgeBottom = 9
Const xlEdgeRight = 10
Const xlInsideVertical = 11
Const xlInsideHorizontal = 12
Const xlContinuous = 1

2  (Initialize)
Sub Initialize
 '/*************************** Created By With on 2011/04/02 ***************************/
 'Dim HaveRight As Variant
 'HaveRight = Evaluate(|@Contains(@UserRoles;"[SystemManagers]")|) 
 'If HaveRight(0) = 0 Then
 ' Msgbox "你無權執行此動作",48,"提示"
 ' Exit Sub
 'End If
 
 Dim wk As New NotesUIWorkspace
 Dim s As New NotesSession
 Dim directory As NotesDbDirectory
 Dim db As NotesDatabase
 Dim serverName As String
 
 serverName = wk.Prompt(PROMPT_OKCANCELEDIT, "提示", "請輸入Server Name，如：INLSZAP01/INL", "", "")
 If serverName = "" Then
  Exit Sub
 End If
 'serverName = "INLSZAP01/INL"
 Set directory = s.GetDbDirectory(serverName)
 'Set directory = New NotesDbDirectory(serverName)
 Set db = directory.GetFirstDatabase(DATABASE)  '獲取Notes資料庫(.nsf、.nsg或.nsh檔案)
 'Set db = directory.GetFirstDatabase(TEMPLATE)  '獲取Notes資料庫範本(.ntf檔案)
 
 Set excelapp = CreateObject("excel.application")
 Set ExcelBook=excelapp.Workbooks.Add
 Set xlsheet = excelapp.Workbooks(1).Worksheets(1) 
 xlsheet.Activate
 excelapp.Windows(1).DisplayGridlines = True 
 '另一種Excel匯出的方法可參考“儀校系統”
 excelapp.Visible = True
 'ExcelBook.Styles("Normal").HorizontalAlignment=-4108
 'ExcelBook.Styles("Normal").VerticalAlignment=-4108
 'ExcelBook.Styles("Normal").Font.Size=10
 excelapp.Sheets("sheet1").Select
 excelapp.Sheets("sheet1").Name = "DB List"
 excelapp.Range("A1:F1").MergeCells = True
 excelapp.Range("A1:F1").FormulaR1C1 = serverName + "下的DB List如下"
 excelapp.Range("A1:F1").HorizontalAlignment = xlCenter
 excelapp.Range("A1:F1").Font.bold = True
 excelapp.Range("A1:F1").Font.Size = 14
 excelapp.Range("A1:F1").Font.ColorIndex = 5  '修改字型的顏色(藍色)
 'excelapp.Rows(1).Font.ColorIndex = 5 '設定整行字型的顏色
 
 '定義欄位的寬度
 excelapp.Columns("A:A").ColumnWidth = 30
 excelapp.Columns("B:B").ColumnWidth =16
 excelapp.Columns("C:C").ColumnWidth = 20
 excelapp.Columns("D:D").ColumnWidth =14
 excelapp.Columns("E:E").ColumnWidth =12
 excelapp.Columns("F:F").ColumnWidth =14
 
 '標題欄賦值
 excelapp.Range("A2").Value = "標題"
 excelapp.Range("B2").Value = "檔名"
 excelapp.Range("C2").Value = "路徑"
 excelapp.Range("D2").Value = "大小(單位M)"
 excelapp.Range("E2").Value = "檔案數"
 excelapp.Range("F2").Value = "Last Modified"
 excelapp.Range("A2:F2").HorizontalAlignment = xlCenter '水平居中對齊設定
 excelapp.Range("A2:F2").Font.Size = 12
 excelapp.Range("A2:F2").Font.bold = True
 excelapp.Range("A2:F2").Interior.ColorIndex = 15 '設定單元格的填充顏色(灰色)
 
 '前兩行單元格增加邊框顯示
 excelapp.Range("A1:F2").WrapText = True
 excelapp.Range("A1:F2").Borders(xlEdgeLeft).LineStyle. = xlContinuous
 excelapp.Range("A1:F2").Borders(xlEdgeTop).LineStyle. = xlContinuous
 excelapp.Range("A1:F2").Borders(xlEdgeBottom).LineStyle. = xlContinuous
 excelapp.Range("A1:F2").Borders(xlEdgeRight).LineStyle. = xlContinuous
 excelapp.Range("A1:F2").Borders(xlInsideVertical).LineStyle. = xlContinuous
 excelapp.Range("A1:F2").Borders(xlInsideHorizontal).LineStyle. = xlContinuous
 
 InsertNum = 3
 While Not db Is Nothing
  Call db.Open("", "")
  
  excelapp.Range("A"+Cstr(InsertNum)).Value = db.Title
  excelapp.Range("B"+Cstr(InsertNum)).Value = db.FileName
  excelapp.Range("C"+Cstr(InsertNum)).Value = db.FilePath
  excelapp.Range("D"+Cstr(InsertNum)).Value = Round(db.Size/1024/1024, 2)
  excelapp.Range("E"+Cstr(InsertNum)).Value = db.AllDocuments.Count
  excelapp.Range("F"+Cstr(InsertNum)).Value = Format(db.LastModified, "yyyy/mm/dd hh:mm")
  
  InsertNum = InsertNum + 1
  Set db = directory.GetNextDatabase()
  
  'If InsertNum = 5 Then Goto flag
 Wend
 
%REM
flag:
 'Excel的額外功能
 '/**************** DB Info內容增加虛線顯示 Begin ******************/
 excelapp.range("A3:F"+Cstr(InsertNum -1)).Select    
 With excelapp.Selection    
  '.font.name="Arial"  
  .borders(1).Weight=1 '單元格左邊框顯示虛線
  .borders(2).Weight=1 '單元格右邊框顯示虛線 
  .borders(3).Weight=1 '單元格上邊框顯示虛線
  .borders(4).Weight=1 '單元格下邊框顯示虛線
  .font.bold=False         
  '.columns.ColumnWidth=7
  .columns.WrapText=True  '使單元格的內容自動換行
  .VerticalAlignment = xlTop '垂直居頂對齊, xlTop值為-4160
  .columns.Shrinktofit=True '自動縮小單元格的字型，使內容全部顯示出來
  '.font.Size = 11
  '.mergecells=True '合並單元格
  '.HorizontalAlignment = xlCenter '水平居中對齊，xlCenter值為-4108
  '.VerticalAlignment = xlCenter  '垂直居中對齊
 End With
 '/**************** DB Info內容增加虛線顯示 End ********************/
 
 '/****************** 頁面增加列印邊界顯示 Begin ********************/
 With xlsheet.PageSetup
  .Orientation =2
  .RightFooter = "Page &P" & Chr$(13) & "Date: &D"  
 End With
 '/****************** 頁面增加列印邊界顯示 End **********************/
%ENDREM 
 
 Messagebox "已經成功匯出 " + Cstr(InsertNum-3) + " 筆資料！"
End Sub

來自 “ ITPUB部落格 ” ，連結：http://blog.itpub.net/24998103/viewspace-700386/，如需轉載，請註明出處，否則將追究法律責任。