EXCEL批量导入PowerDesigner

背景

公司需要我们把字段到powerdesigner中。于是我开始搜如何将数据库建表语句逆向导入到powerdesigner中，方法倒是有，需要连接oracle数据库。可是我本地还没配oracle环境。
冥思苦想突然发现，原来前人早就有从excel批量导入powerdesigner的方法。

方案

vbs脚本！

步骤

第一步：复制下面的代码，在桌面建一个txt文件，粘贴代码。

Option Explicit
Private CURRENT_MODEL_NAME
Private CURRENT_MODEL
Private TABLES
Private EXCEL_APP
Private FILE_PATH
CURRENT_MODEL_NAME = "model名"
Set EXCEL_APP = CreateObject("Excel.Application")
FILE_PATH="F:\xx\ZhuoMian\456.xlsx"    '文件的绝对路径
'FILE_PATH="F:\xx\ZhuoMian\456.xlsx"    '文件的绝对路径

'检查文件是否存在
If CheckFileExsistence() Then
   '检查当前是否有已经打开的物理图
   Call GetModelByName(CURRENT_MODEL)
   If CURRENT_MODEL Is Nothing Then
      MsgBox("请先打开一个名称为“" & CURRENT_MODEL_NAME & "”的物理数据模型（Physical Data Model），然后再进执行导入！")
   Else
      Set TABLES = CURRENT_MODEL.Tables
      '根据EXCEL表格创建模型
      ImportModels()
   End If
Else
   MsgBox "文件" + FILE_PATH + "不存在！"
End If


'============================================================
'导入模型
'============================================================
Sub ImportModels
   '打开Excel文件
   Dim Filename
   Dim ReadOnly
   EXCEL_APP.Workbooks.Open FILE_PATH

   Dim worksheets
   Dim worksheetCount
   Set worksheets = EXCEL_APP.Worksheets
   worksheetCount = worksheets.Count
   If worksheetCount <= 0 Then
      Exit Sub
   End If
   
   Dim index
   Dim currentSheet
   For index = 1 to worksheetCount
      Set currentSheet = worksheets(index)
      Call CreateTable(currentSheet)
   Next
   
   '关闭Excel文件
   EXCEL_APP.Workbooks.Close
   MsgBox "导入完成！"
End Sub


'============================================================
'创建表
'============================================================
Sub CreateTable(ByRef worksheet)
   Dim cells
   Set cells = worksheet.Cells
   Dim table
   
   '检查具有相同名称的表是否已经存在
   Call GetTableByName(table, worksheet.Name)
   If table Is Nothing Then
      Set table = TABLES.CreateNew
      table.Name = cells(1, 1).Value
      table.Code = cells(1, 2).Value
      table.Comment = cells(1, 3).Value
      'table.Name = worksheet.Name
      'table.Code = worksheet.Name
      'table.Comment = worksheet.Name
   End If
   
   Dim index
   Dim rows
   Dim col
   Set rows = worksheet.Rows
   'For index = 3 to 512
   For index = 3 to 120
      If EXCEL_APP.WorksheetFunction.CountA(rows(index)) <= 0 Then
      'If EXCEL_APP.WorksheetFunction.CountA(rows(index)) <= 0 and index > 96 Then
         Exit For
      End If
      
      If ((cells(index,1).Value = "") or (cells(index,2).Value = "Name" ))Then '第二列为空的都可以忽略
            'MsgBox "值2"
         'continue    '这里忽略空行和表名行、表头行
        Else 
            set col =table.Columns.CreateNew '创建一列/字段
         col.Code = cells(index, 1).Value    '指定列code
         'MsgBox "值3"
         col.DataType = cells(index, 3).Value    '指定列数据类型
         If cells(index, 4).Value = "Y" Then'指定主键
                col.Primary =true
                col.identity=true
         Else
            If cells(index, 5).Value = "否" Then'指定列是否可空 true 为不可空
                   col.Mandatory =true
            
            End If
            
            End If
            col.Name = cells(index, 2).Value    '指定列name            
            col.Comment = cells(index, 2).Value  '指定列说明
         'count = count + 1
        End If    
   Next
End Sub


'============================================================
'检查文件是否存在
'============================================================
Function CheckFileExsistence
   Dim fso
   Set fso = CreateObject("Scripting.FileSystemObject")
   CheckFileExsistence = fso.FileExists(FILE_PATH)
End Function


'============================================================
'根据数据类型名称，精度和刻度生成数据类型
'============================================================
Function GenerateDataType(dataTypeName, precision, scale)
   Select Case Ucase(dataTypeName)
      Case Empty
         GenerateDataType = Empty
      Case "NUMBER"
         GenerateDataType = "NUMBER(" & precision & "," & scale & ")"
   End Select
End Function


'============================================================
'获取指定指定名称的数据模型
'============================================================
Sub GetModelByName(ByRef model)
   Dim md
   For Each md in Models
      If StrComp(md.Name, CURRENT_MODEL_NAME) = 0 Then
         Set model = md
         Exit Sub
      End If
   Next
   Set model = Nothing
End Sub


'============================================================
'根据表名称获取对应的表
'============================================================
Sub GetTableByName(ByRef table, tableName)
   Dim tb
   For Each tb in TABLES
      If StrComp(tb.Name, tableName) = 0 Then
         Set table = tb
         Exit Sub
      End If
   Next
   Set table = Nothing
End Sub


'============================================================
'检查字段是否已经存在
'============================================================
Function ColumnExists(ByRef table, columnName)
   Dim col
   For Each col in table.Columns
      If StrComp(col.Name, columnName) = 0 Then
         ColumnExists = True
         Exit Function
      End If
   Next
   ColumnExists = False
End Function

 
第二步：更改txt名称，改为excel.vbs
第三步：将你的excel格式改造如下图所示：
　　其中位置必须一致，可以纵向拓展，所有字段均严格按此图排列（颜色没必要）。
　　其中第一行为表的信息，第二行为固定格式，第三行至第N行为你的字段信息。
　　如果想建多个表，就继续加sheet，每个sheet布局均需严格按照图示。

 
打开powerdesigner，打开新建的项目。记住红框1的名字。项目

 

使用脚本。

 

打开桌面脚本。

 

选择脚本。

 

修改部分代码：将代码红框位置改为刚刚红框1的名字。
下面的路径为你excel的绝对路径。RUN即可导入。