[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/,如需轉載,請註明出處,否則將追究法律責任。
相關文章
- 資料庫 MySQL 資料匯入匯出資料庫MySql
- SQL Server 2014 匯出資料字典SQLServer
- Skill 匯出所有Layer資訊用於tapeout
- SQL資料庫的匯入和匯出SQL資料庫
- 2.4用按鍵精靈匯出滬深A股所有股票指定的指標資料指標
- oracle 備份資料庫,匯出資料庫Oracle資料庫
- SQL Server 查詢資料庫中所有表資料條數SQLServer資料庫
- Mysql 資料庫匯入與匯出MySql資料庫
- 【資料庫資料恢復】windows server下SqlServer資料庫的資料恢復資料庫資料恢復WindowsServerSQL
- 如何用PLSQL匯出資料庫存表結構資訊SQL資料庫
- 2.2匯出幾隻股的指定的指標資料指標
- Oracle資料庫——資料匯出時出現匯出成功終止, 但出現警告。Oracle資料庫
- python將目標檢測資料匯入到指定資料庫中Python資料庫
- MySQL匯出資料庫指令碼MySql資料庫指令碼
- 將資料庫中資料匯出為excel表格資料庫Excel
- mysqldump匯出匯入所有庫、某些庫、某些表的例子MySql
- 如何刪除資料庫下的所有表(mysql)資料庫MySql
- Laravel-admin 自定義csv匯出,支援原有匯出csv的所有功能,匯出所有資料使用分頁查詢處理Laravel
- Oracle資料庫匯入匯出。imp匯入命令和exp匯出命令Oracle資料庫
- Oracle匯出資料庫與還原Oracle資料庫
- [Docker核心之容器、資料庫檔案的匯入匯出、容器映象的匯入匯出]Docker資料庫
- oracl 資料庫 sqlplus 匯出資料為sql檔案資料庫SQL
- 達夢資料庫遷移資料/複製表/匯入匯出2資料庫
- SQL Server資料庫出現邏輯錯誤的資料恢復SQLServer資料庫資料恢復
- MySQL資料的匯出MySql
- python的應用 | 提取指定資料夾下所有PDF檔案的頁數Python
- 大文字資料,匯入匯出到資料庫資料庫
- 在MySQL中,如何獲取資料庫下所有表的資料行數?MySql資料庫
- OracleDatabase——資料庫表空間dmp匯出與匯入OracleDatabase資料庫
- Mongodb資料的匯出與匯入MongoDB
- 匯入和匯出AWR的資料
- EasyPoi, Excel資料的匯入匯出Excel
- 資料庫文件編寫,如何通過Navicat把表導成表格?資料庫快速匯出為excel表格資訊,excel匯出到word表格資料庫Excel
- sqoop資料匯入匯出OOP
- Oracle 資料匯入匯出Oracle
- 資料泵匯出匯入
- Oracle資料匯入匯出Oracle
- phpMyAdmin匯入/匯出資料PHP
- mysql匯出資料MySql