PowerDesigner导出表结构、表字段到Excel

公司今天想要汇总pdm的表信息到Excel表格中，这种工作量自然不能人工汇总啦，现将脚本记录一下。

查询表结构到Excel中：

'******************************************************************************
'* File:     ShowTableList.vbs
'* Purpose:  表结构并导出Excel
'* Title:    
'* Category: 
'* Version:  1.0
'* Author:  yex
'******************************************************************************
Option Explicit
ValidationMode = True
InteractiveMode = im_Batch
' get the current active model
Dim mdl ' the current model
Set mdl = ActiveModel
Dim EXCEL,sheet,rowsNum
rowsNum = 1
 
If (mdl Is Nothing) Then
    MsgBox "There is no Active Model"
Else
    SetExcel
    ListObjects(mdl)
End If
'-----------------------------------------------------------------------------
' Sub procedure to scan current package and print information on objects from current package
' and call again the same sub procedure on all children pacakge 
' of the current package
'-----------------------------------------------------------------------------
Private Sub ListObjects(fldr)
    output "Scanning " & fldr.code
    Dim obj ' running object
    For Each obj In fldr.children
        ' Calling sub procedure to print out information on the object
        DescribeObject obj
    Next
    ' go into the sub-packages
    Dim f ' running folder
    For Each f In fldr.Packages
        'calling sub procedure to scan children package
        ListObjects f
    Next
End Sub
'-----------------------------------------------------------------------------
' Sub procedure to print information on current object in output
'-----------------------------------------------------------------------------
Private Sub DescribeObject(CurrentObject)
    if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
    if CurrentObject.Iskindof(cls_Table) then 
        ExportTable CurrentObject, sheet
    else
        output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)   
    End if
End Sub
 
 
Sub SetExcel()
    Set EXCEL= CreateObject("Excel.Application")
 
    ' Make Excel visible through the Application object.
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="pdm"
    set sheet = EXCEL.workbooks(1).sheets("pdm")
 
    ' Place some text in the first Row of the sheet.
    sheet.Cells(rowsNum, 1).Value = "表英文名"
    sheet.Cells(rowsNum, 2).Value = "表中文名"
    sheet.Cells(rowsNum, 3).Value = "表描述"
End Sub
 
Sub ExportTable(tab, sheet)
    Dim col ' running column
    Dim colsNum
    rowsNum = rowsNum + 1
	sheet.Cells(rowsNum, 1).Value = tab.code
	sheet.Cells(rowsNum, 2).Value = tab.name
	sheet.Cells(rowsNum, 3).Value = tab.comment
    output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub 

查询表中字段信息到Excel中：

'******************************************************************************
'* File:     pdm2excel.vbs
'* Purpose:  导出字段信息
'* Title:    
'* Category: 
'* Version:  1.0
'* Author:  yex
'******************************************************************************
Option Explicit
ValidationMode = True
InteractiveMode = im_Batch
' get the current active model
Dim mdl ' the current model
Set mdl = ActiveModel
Dim EXCEL,sheet,rowsNum
rowsNum = 1
 
If (mdl Is Nothing) Then
    MsgBox "There is no Active Model"
Else
    SetExcel
    ListObjects(mdl)
End If
'-----------------------------------------------------------------------------
' Sub procedure to scan current package and print information on objects from current package
' and call again the same sub procedure on all children pacakge 
' of the current package
'-----------------------------------------------------------------------------
Private Sub ListObjects(fldr)
    output "Scanning " & fldr.code
    Dim obj ' running object
    For Each obj In fldr.children
        ' Calling sub procedure to print out information on the object
        DescribeObject obj
    Next
    ' go into the sub-packages
    Dim f ' running folder
    For Each f In fldr.Packages
        'calling sub procedure to scan children package
        ListObjects f
    Next
End Sub
'-----------------------------------------------------------------------------
' Sub procedure to print information on current object in output
'-----------------------------------------------------------------------------
Private Sub DescribeObject(CurrentObject)
    if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
    if CurrentObject.Iskindof(cls_Table) then 
        ExportTable CurrentObject, sheet
    else
        output "Found "+CurrentObject.ClassName+" """+CurrentObject.Name+""", Created by "+CurrentObject.Creator+" On "+Cstr(CurrentObject.CreationDate)   
    End if
End Sub
 
 
Sub SetExcel()
    Set EXCEL= CreateObject("Excel.Application")
 
    ' Make Excel visible through the Application object.
    EXCEL.Visible = True
    EXCEL.workbooks.add(-4167)'添加工作表
    EXCEL.workbooks(1).sheets(1).name ="pdm"
    set sheet = EXCEL.workbooks(1).sheets("pdm")
 
    ' Place some text in the first Row of the sheet.
    sheet.Cells(rowsNum, 1).Value = "字段英文名"
    sheet.Cells(rowsNum, 2).Value = "字段中文名"
	sheet.Cells(rowsNum, 3).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 = "是否可空"
End Sub
 
Sub ExportTable(tab, sheet)
    Dim col ' running column
    Dim colsNum
    colsNum = 0
    for each col in tab.columns
        colsNum = colsNum + 1
        rowsNum = rowsNum + 1
        sheet.Cells(rowsNum, 1).Value = col.code
        sheet.Cells(rowsNum, 2).Value = col.name
        sheet.Cells(rowsNum, 3).Value = tab.code
        sheet.Cells(rowsNum, 4).Value = col.datatype
        sheet.Cells(rowsNum, 5).Value = ""
        sheet.Cells(rowsNum, 6).Value = col.comment
        sheet.Cells(rowsNum, 7).Value = col.primary
        sheet.Cells(rowsNum, 8).Value = col.mandatory
    next
    output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub