PowerDesigner遍历导出所有表结构到Excel

PowerDesigner遍历导出所有表到Excel

1.打开需要导出表结构到Excel的pdm文件

2.点击Tools|Execute Commands|Edit/Run Script菜单或按下快捷键Ctrl + Shift + X打开脚本窗口，输入示例VBScript脚本，修改其中的Excel模板路径及工作薄页签，点Run按钮执行即可

3.VBScript脚本

'******************************************************************************
'* File:     pdm2excel.vbs
'* Purpose:  分目录递归，查找当前PDM下所有表，并导出Excel
'* Title:    
'* Category: 
'* Version:  1.0
'******************************************************************************
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,fldr.name
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,packageName)
if not CurrentObject.Iskindof(cls_NamedObject) then exit sub
if CurrentObject.Iskindof(cls_Table) then 
ExportTable CurrentObject, sheet,packageName
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导出到Excel"
set sheet = EXCEL.workbooks(1).sheets("PDM导出到Excel")
' 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 = "是否主键"
sheet.Cells(rowsNum, 9).Value = "是否非空"
sheet.Cells(rowsNum, 10).Value = "字段类型"
sheet.Cells(rowsNum, 11).Value = "表所在package名称"
End Sub
Sub ExportTable(tab, sheet,packageName)
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 = colsNum
sheet.Cells(rowsNum, 2).Value = tab.code
sheet.Cells(rowsNum, 3).Value = tab.name
sheet.Cells(rowsNum, 4).Value = tab.comment
sheet.Cells(rowsNum, 5).Value = col.code
sheet.Cells(rowsNum, 6).Value = col.name
sheet.Cells(rowsNum, 7).Value = col.comment
If col.Primary = true Then
sheet.cells(rowsNum, 8) = "是" 
Else
sheet.cells(rowsNum, 8) = "否" 
End If
If col.Mandatory = true Then
sheet.cells(rowsNum, 9) = "是" 
Else
sheet.cells(rowsNum, 9) = "否" 
End If
sheet.Cells(rowsNum, 10).Value = col.datatype
sheet.Cells(rowsNum, 11).Value =packageName
next
'设置列宽
sheet.Columns(1).ColumnWidth =5 
sheet.Columns(2).ColumnWidth = 30 
sheet.Columns(3).ColumnWidth = 30 
sheet.Columns(4).ColumnWidth = 30 
sheet.Columns(5).ColumnWidth = 30 
sheet.Columns(6).ColumnWidth = 30 
sheet.Columns(7).ColumnWidth = 30 
sheet.Columns(8).ColumnWidth = 10 
sheet.Columns(9).ColumnWidth = 10 
sheet.Columns(10).ColumnWidth = 20 
sheet.Columns(11).ColumnWidth = 30 
'若果需要表头居中显示就把下面的注释内容放开
'sheet.Range(sheet.cells(1,1),sheet.cells(1,11)).HorizontalAlignment = 3
sheet.Range(sheet.cells(1,1),sheet.cells(1,11)).Font.Bold = True
output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub 

[2024-06-08]