PowerDesigner导入excel生成sql语句

（不足：唯一键unique key的方式用唯一索引unique index代替了）

• 一、创建excel表

（可有多个sheet，注意保存格式一致，主要是列数要对好，或者就通过改代码cells(index, 4)中的4可以自己定义列数，该代码是以最后一列为空时结束代码）

1. excel第一行格式固定如上，1-A是英文表名，1-B是中文表名
2. 注意保持格式一致

• 二、导入步骤

  PowerDesigner中打开File——>New Model——>Model types——>Physical Data Mode：

（我选的是pg数据库，你们看自己是什么数据库）

3.按住Ctrl+Shift+X进入脚本运行界面，导入以下脚本并运行：

（1）注意修改表名和Excel文件路径：

        CURRENT_MODEL_NAME = "aaa"；

        FILE_PATH="C:\Users\lanji\Desktop\2024.4、5月文档\Mxtracted_Products_Info.xlsx"    '文件的绝对路径。

代码如下：

'============================================================
'从Excel文件中导入PowerDesigner 物理数据模型
'
'注意：1，Excel表格中不能有合并的单元格
'      2，列之间不能有空行格
'      3，注意文件是绝对地址，还有填好自己的model名

'============================================================
 
 
Option Explicit
 
'============================================================
'私有全局变量。
'============================================================
Private CURRENT_MODEL_NAME
Private CURRENT_MODEL
Private TABLES
Private EXCEL_APP
Private FILE_PATH
CURRENT_MODEL_NAME = "aaa"
Set EXCEL_APP = CreateObject("Excel.Application")
FILE_PATH="C:\Users\lanji\Desktop\2024.4、5月文档\Mxtracted_Products_Info1.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
    Dim indexSet  ' 用于存储需要索引的列
    Dim uniqueSet ' 新增：用于存储需要设置唯一约束的列
    Set indexSet = CreateObject("Scripting.Dictionary")
    Set uniqueSet = CreateObject("Scripting.Dictionary")  ' 创建一个新的字典对象来存储需要唯一约束的列
    
    ' 检查具有相同名称的表是否已经存在
    Call GetTableByName(table, worksheet.Name)
    If table Is Nothing Then
        Set table = TABLES.CreateNew
        table.Name = cells(1, 2).Value
        table.Code = cells(1, 1).Value
        table.Comment = cells(1, 2).Value
    End If
    
    Dim index
    Dim rows
    Dim col
    Set rows = worksheet.Rows
    For index = 3 to 512
        If EXCEL_APP.WorksheetFunction.CountA(rows(index)) <= 0 Then
            Exit For
        End If
        
        If Not ((cells(index, 1).Value = "") Or (cells(index, 2).Value = "Name")) Then
            Set col = table.Columns.CreateNew
            col.Code = cells(index, 1).Value
            col.DataType = cells(index, 3).Value
            If cells(index, 4).Value = "Y" Then
                col.Primary = True
            Else
                If cells(index, 5).Value = "Y" Then
                    col.Mandatory = True
                End If
            End If
            col.Name = cells(index, 2).Value
            col.Comment = cells(index, 6).Value
            
            ' 检查是否需要为此列添加索引
            If cells(index, 7).Value = "Y" Then
              call  indexSet.Add(col.Code, col)
            End If
            
            ' 检查第8列是否标记为"Y"，设置唯一键
            If cells(index, 8).Value = "Y" Then
                Call uniqueSet.Add(col.Code, col)
            End If
            
        End If
    Next
    
    ' 为每个标记的列单独创建索引
    Dim colCode, indexColumn, newIndex
    For Each colCode In indexSet.Keys
        Set newIndex = table.Indexes.CreateNew
        newIndex.Name = "ix_" & table.Name & "$" & colCode
        newIndex.Code = "ix_" & table.Name & "$" & colCode
        
        Set indexColumn = newIndex.IndexColumns.CreateNew()
        indexColumn.Column = indexSet.Item(colCode)
        newIndex.IndexColumns.Add(indexColumn)
        
        table.Indexes.Add newIndex
    Next
    
   ' 为标记的列创建唯一约束
    
    For Each colCode In uniqueSet.Keys
        Dim newUnique, uniqueColumn
        Set newUnique = table.Indexes.CreateNew
        newUnique.Name = "uq_" & table.Name & "$" & colCode
        newUnique.Code = "uq_" & table.Name & "$" & colCode
        newUnique.Unique = True  ' 确保是唯一约束
        
        Set uniqueColumn = newUnique.IndexColumns.CreateNew()
        uniqueColumn.Column = uniqueSet.Item(colCode)
        newUnique.IndexColumns.Add(uniqueColumn)
        
        table.Indexes.Add newUnique
    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

• 三、转成sql语句

1.选中tables或者相关表，选中tables可以将全部表转化成sql

2.进行相关设置（取消中文乱码）：

1. General页面不选中check model
2. Format中的Encoding选择utp-8，然后确认即可

• 四、成功