分目錄遞歸，查找當(dāng)前PDM下所有表，并導(dǎo)出Excel

'******************************************************************************
'* File:     Exported_Excel_page.vbs
'* Purpose:  分目錄遞歸，查找當(dāng)前PDM下所有表碉京，并導(dǎo)出Excel
'* Title:    
'* Category: 
'* Version:  1.0
'* Author:  787681084@qq.com
'******************************************************************************

Option Explicit
ValidationMode = True
InteractiveMode = im_Batch

'-----------------------------------------------------------------------------
' 主函數(shù)
'-----------------------------------------------------------------------------
' 獲取當(dāng)前活動(dòng)模型
Dim mdl ' 當(dāng)前的模型
Set mdl = ActiveModel
Dim EXCEL,catalog,sheet,catalogNum,rowsNum,linkNum
rowsNum = 1
catalogNum = 1
linkNum = 1

If (mdl Is Nothing) Then
    MsgBox "There is no Active Model"
Else
    SetCatalog
    ListObjects(mdl)
End If

'----------------------------------------------------------------------------------------------
' 子過(guò)程僵芹，用于掃描當(dāng)前包并從當(dāng)前包中打印對(duì)象的信息瀑志，然后對(duì)當(dāng)前包的所有子包再次調(diào)用相同的子過(guò)程
'----------------------------------------------------------------------------------------------
Private Sub ListObjects(fldr)
    output "Scanning " & fldr.code
    Dim obj ' 運(yùn)行對(duì)象
    For Each obj In fldr.children
        ' 調(diào)用子過(guò)程來(lái)打印對(duì)象上的信息
        DescribeObject obj
    Next
    ' 進(jìn)入子包
    Dim f ' 運(yùn)行文件夾
    For Each f In fldr.Packages
        '調(diào)用子程序掃描子程序包
        ListObjects f
    Next
End Sub

'-----------------------------------------------------------------------------
' 子過(guò)程坛猪，用于在輸出中打印當(dāng)前對(duì)象的信息
'-----------------------------------------------------------------------------
Private Sub DescribeObject(CurrentObject)
    if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
    if CurrentObject.Iskindof(cls_Table) then 
        AddSheet CurrentObject.code
        ExportTable CurrentObject, sheet
        ExportCatalog CurrentObject
    else
        output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)   
    End if
End Sub

'----------------------------------------------------------------------------------------------
' 設(shè)置Excel的sheet頁(yè)
'----------------------------------------------------------------------------------------------
Sub SetExcel()
    Set EXCEL= CreateObject("Excel.Application")

    ' 使Excel通過(guò)應(yīng)用程序?qū)ο罂梢?jiàn)脖阵。
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="pdm"
    set sheet = EXCEL.workbooks(1).sheets("pdm")

    ' 將一些文本放在工作表的第一行
    sheet.Cells(rowsNum, 1).Value = "表名"
    sheet.Cells(rowsNum, 2).Value = "表中文名"
    sheet.Cells(rowsNum, 3).Value = "表備注"
    sheet.Cells(rowsNum, 4).Value = "字段ID"
    sheet.Cells(rowsNum, 5).Value = "字段名"
    sheet.Cells(rowsNum, 6).Value = "字段中文名"
    sheet.Cells(rowsNum, 7).Value = "字段類型"
    sheet.Cells(rowsNum, 8).Value = "字段備注"
    sheet.cells(rowsNum, 9).Value = "主鍵"
    sheet.cells(rowsNum, 10).Value = "非空"
    sheet.cells(rowsNum, 11).Value = "默認(rèn)值"
End Sub

'----------------------------------------------------------------------------------------------
' 導(dǎo)出目錄結(jié)構(gòu)
'----------------------------------------------------------------------------------------------
Sub ExportCatalog(tab)
    catalogNum = catalogNum + 1
    catalog.cells(catalogNum, 1).Value = tab.parent.name
    catalog.cells(catalogNum, 2).Value = tab.code
    catalog.cells(catalogNum, 3).Value = tab.comment
    '設(shè)置超鏈接
    catalog.Hyperlinks.Add catalog.cells(catalogNum,2), "",tab.code&"!A2"
End Sub 

'----------------------------------------------------------------------------------------------
' 導(dǎo)出sheet頁(yè)
'----------------------------------------------------------------------------------------------
Sub ExportTable(tab, sheet)
    Dim col ' 運(yùn)行列
    Dim colsNum
    colsNum = 0
    for each col in tab.columns
        colsNum = colsNum + 1
        rowsNum = rowsNum + 1
        sheet.Cells(rowsNum, 1).Value = tab.code
        'sheet.Cells(rowsNum, 2).Value = tab.name
        sheet.Cells(rowsNum, 2).Value = tab.comment
        'sheet.Cells(rowsNum, 4).Value = colsNum
        sheet.Cells(rowsNum, 3).Value = col.code
        'sheet.Cells(rowsNum, 4).Value = col.name
        sheet.Cells(rowsNum, 4).Value = col.datatype
        sheet.Cells(rowsNum, 5).Value = col.comment
        
        If col.Primary = true Then
            sheet.cells(rowsNum, 6) = "Y" 
        Else
            sheet.cells(rowsNum, 6) = "" 
        End If
        If col.Mandatory = true Then
            sheet.cells(rowsNum, 7) = "Y" 
        Else
            sheet.cells(rowsNum, 7) = "" 
        End If
        
        sheet.cells(rowsNum, 8).Value = col.defaultvalue
        '設(shè)置居中顯示
        sheet.cells(rowsNum,6).HorizontalAlignment = 3
        sheet.cells(rowsNum,7).HorizontalAlignment = 3
    next
    output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub 

'----------------------------------------------------------------------------------------------
' 設(shè)置Excel目錄頁(yè)
'----------------------------------------------------------------------------------------------
Sub SetCatalog()
    Set EXCEL= CreateObject("Excel.Application")
    
    ' 使Excel通過(guò)應(yīng)用程序?qū)ο罂梢?jiàn)。
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="表結(jié)構(gòu)"
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(1).name ="目錄"
    set catalog = EXCEL.workbooks(1).sheets("目錄")

    catalog.cells(catalogNum, 1) = "模塊"
    catalog.cells(catalogNum, 2) = "表名"
    catalog.cells(catalogNum, 3) = "表注釋"
    
    ' 設(shè)置列寬和自動(dòng)換行
    catalog.Columns(1).ColumnWidth = 20
    catalog.Columns(2).ColumnWidth = 25
    catalog.Columns(3).ColumnWidth = 55
    
    '設(shè)置首行居中顯示
    
    catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).HorizontalAlignment = 3
    '設(shè)置首行字體加粗
    catalog.Range(catalog.cells(1,1),catalog.cells(1,3)).Font.Bold = True
End Sub 

'----------------------------------------------------------------------------------------------
' 新增sheet頁(yè)
'----------------------------------------------------------------------------------------------
Sub AddSheet(sheetName)
    EXCEL.workbooks(1).Sheets(2).Select
    EXCEL.workbooks(1).sheets.add
    EXCEL.workbooks(1).sheets(2).name = sheetName
    set sheet = EXCEL.workbooks(1).sheets(sheetName)
    rowsNum = 1
    '將一些文本放在工作表的第一行
    sheet.Cells(rowsNum, 1).Value = "表名"
    'sheet.Cells(rowsNum, 2).Value = "表中文名"
    sheet.Cells(rowsNum, 2).Value = "表備注"
    'sheet.Cells(rowsNum, 4).Value = "字段ID"
    sheet.Cells(rowsNum, 3).Value = "字段名"
    'sheet.Cells(rowsNum, 4).Value = "字段中文名"
    sheet.Cells(rowsNum, 4).Value = "字段類型"
    sheet.Cells(rowsNum, 5).Value = "字段備注"
    sheet.cells(rowsNum, 6).Value = "主鍵"
    sheet.cells(rowsNum, 7).Value = "非空"
    sheet.cells(rowsNum, 8).Value = "默認(rèn)值"
    
    '設(shè)置列寬
    sheet.Columns(1).ColumnWidth = 20
    sheet.Columns(2).ColumnWidth = 20
    sheet.Columns(3).ColumnWidth = 20
    sheet.Columns(4).ColumnWidth = 20
    sheet.Columns(5).ColumnWidth = 20
    sheet.Columns(6).ColumnWidth = 5
    sheet.Columns(7).ColumnWidth = 5
    sheet.Columns(8).ColumnWidth = 10

    '設(shè)置首行居中顯示
    sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).HorizontalAlignment = 3
    '設(shè)置首行字體加粗
    sheet.Range(sheet.cells(1,1),sheet.cells(1,8)).Font.Bold = True
    
    linkNum = linkNum + 1
    '設(shè)置超鏈接
    sheet.Hyperlinks.Add sheet.cells(1,1), "","目錄"&"!B"&linkNum
End Sub