加载中…数据库设计：电子表格导入PD15
(2022-04-26 13:05:07)
导入脚本
MsgBox "There is no Active Model"
' Open & Create Excel Document
Set x1 =
CreateObject("Excel.Application")
x1.Workbooks.Open
"D:\表结构整理.xlsx" '指定excel文档路径
x1.Workbooks(1).Worksheets(shet).Activate
'指定要打开的sheet名称
'Excel中表头的1列是表名，2空，3是表注释
set table = mdl.Entities.CreateNew
'创建一个表实体
table.Code =
.Cells(2,2).Value
'表编码
table.Name =
.Cells(2,5).Value
'表名称
If .Cells(2, 7) <> "" Then
col.PrimaryIdentifier =true
col.Domain
=ActiveModel.FindChildByName(.Cells(rwIndex, 6).Value,
cls_Domain)
Output "Domain: " &
.Cells(rwIndex, 6).Value
col.Comment = .Cells(rwIndex,
7).Value '指定列说明
col.Comment = .Cells(rwIndex,
5).Value '指定列说明
![]( "数据库设计：电子表格导入PD15")
Option Explicit
dim shet
dim countTables
Dim x1 '
countTables = 0
For each shet in array("t1","t2")
'列出excel文件所有sheet名称,如s1, s2, s3~~~~~~
Dim mdl ' the current model
Set mdl = ActiveModel
If (mdl Is Nothing) Then
End If
addTable x1, mdl
countTables = countTables + 1
Next
MsgBox "生成表共计 " + CStr(countTables) + "个", vbOK +
vbInformation, "表"
x1.Workbooks.Close
x1.Quit
' =========================
sub addTable(x1, mdl)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count
dim domainName
on error Resume Next
'--------------------------------
'下面是读取excel，添加表实体属性
'--------------------------------
With x1.Workbooks(1).Worksheets(shet) '需要循环的sheet名称
table.Comment = .Cells(2,7).Value
'表注释说明
Else
table.Comment = .Cells(2,2).Value
End If
For rwIndex = 4 To 50
'指定要遍历的Excel行标 由于第2行是表头，从第3行开始，看你这个表设计多少行
If .Cells(rwIndex, 1).Value <> "" Then
set col =table.Attributes.CreateNew
'创建一列/字段
col.Code = .Cells(rwIndex, 1).Value
'指定列code
col.Name = .Cells(rwIndex, 5).Value
'指定列name
If .Cells(rwIndex, 4).Value = "Y" Then'指定主键
End If
col.DataType = .Cells(rwIndex, 2).Value & "(" &
.Cells(rwIndex, 3).Value & ")" '指定列数据类型
If Not .Cells(rwIndex, 6).Value Is Nothing Then
End If
If .Cells(rwIndex, 7) <> "" Then
Else
End If
count = count + 1
End If
Next
Output "生成数据表:"+.Cells(2,2).Value+",共计 " + CStr(count)
+"个字段"
End With
Exit Sub
End sub
===
电子文件格式：
喜欢
0
赠金笔