PowerDesigner导出所有表到Excel

2019独角兽企业重金招聘Python工程师标准>>>

导出到excel

'******************************************************************************
'* File:     pdm2excel.vbs
'* Purpose:  分目录递归，查找当前PDM下所有表，并导出Excel
'* Title:    
'* Category: 
'* Version:  1.0
'* Author:  huhaicool@sina.com
'******************************************************************************
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 = "字段ID"
    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 = tab.code
        sheet.Cells(rowsNum, 2).Value = tab.name
        sheet.Cells(rowsNum, 3).Value = tab.comment
        sheet.Cells(rowsNum, 4).Value = colsNum
        sheet.Cells(rowsNum, 5).Value = col.code
        sheet.Cells(rowsNum, 6).Value = col.name
        sheet.Cells(rowsNum, 7).Value = col.datatype
        sheet.Cells(rowsNum, 8).Value = col.comment
    next
    output "Exported table: "+ +tab.Code+"("+tab.Name+")"
End Sub 

Excel导入PowerDesigner

下面代码针对hive，其他数据库自行修改 excel表头如下 表名 中文表名 字段名 字段中文名 数据类型

Option Explicit

'
' get the current active model
'
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
   MsgBox "There is no Active Model"
End If


Dim HaveExcel
Dim RQ
Dim excfile
Dim wrkbok
Dim sht
RQ = MsgBox ("Is Excel Installed on your machine ?", vbYesNo + vbInformation,"Confirmation")
if RQ= VbYes then
    HaveExcel= True
    ' Open & Create Excel Document
    Set excfile = CreateObject("Excel.Application")
    Set wrkbok=excfile.Workbooks.Open("D:\doc\dic.xlsx")
    ' excfile.Visible = True
    Set sht=wrkbok.Sheets("Sheet1")
    'Output sht.Range("B:B").Count '1048576 not max rows 
    ReadExcel2PDM
else
   HaveExcel= false
end if

Private sub ReadExcel2PDM
    Dim i,j,maxRow,maxCols
    maxRow=sht.UsedRange.Rows.Count 'max rows
    maxCols=sht.UsedRange.Columns.Count 'max columns
    Dim tabName

    tabName = ""
    For i = 2 To maxRow Step 1
        Dim tbl,col
        If sht.Cells(i,1).Value <>"" Then
            If tabName<>sht.Cells(i,1).Value Then 
                tabName=sht.Cells(i,1).Value
                set tbl = mdl.Tables.CreateNew
                dim dt_col
                set dt_col = tbl.Columns.CreateNew
                dt_col.code="acct_date"
                dt_col.name="统计日期"
                dt_col.datatype="string"
                'dt_col.PartitionColumn=True
                tbl.PhysicalOptions="row format delimited"+vbCrLf+"fields terminated by '\t'"+vbCrLf+"lines terminated by '\n';"
                tbl.code=tabName
                tbl.name=sht.Cells(i,2).Value
                tbl.comment=sht.Cells(i,2).Value
            End If

            set col = tbl.Columns.CreateNew
            col.code=sht.Cells(i,4).Value
            'if col.code="acct_date" then
             '  col.PartitioningColumn=True
            'end if
            col.datatype=sht.Cells(i,5).Value
            col.name=sht.Cells(i,3).Value
            col.comment=sht.Cells(i,3).Value
            Output "Import PDM from excel ,table:" + tabName + ",Column:" + sht.Cells(i,4).Value
        End If
    Next
    wrkbok.Close()
End Sub

转载于:https://my.oschina.net/huhaicool/blog/2208288