表结构如图:
中文表名 | 英文表名 | 字段编码 | 字段名称 | 字段注释 | 字段类型 | 是否主键 | 是否可空 | 主键是否自增 |
user1 | 用户信息表1 | id | id | id | int(10) | Y | Y | Y |
user1 | 用户信息表1 | name | 用户名 | 用户名 | varchar(100) | N | Y | |
user1 | 用户信息表1 | password | 密码 | 密码 | varchar(100) | N | Y | |
user2 | 用户信息表2 | id | id | id | int(10) | Y | Y | |
user2 | 用户信息表2 | name | 用户名 | 用户名 | varchar(100) | N | Y | |
user2 | 用户信息表2 | password | 密码 | 密码 | varchar(100) | N | Y | |
user3 | 用户信息表3 | id | id | id | int(10) | Y | Y | |
user3 | 用户信息表3 | name | 用户名 | 用户名 | varchar(100) | N | Y | |
user3 | 用户信息表3 | password | 密码 | 密码 | varchar(100) | N | Y |
直接上代码:
Option Explicit
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 x1sApp,xlsWorkBook,xlsSheet
RQ = vbYes 'MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation")
If RQ = vbYes Then
HaveExcel = True
' Open & Create Excel Document
Set x1sApp = CreateObject("Excel.Application")
set xlsWorkBook = x1sApp.Workbooks.Open("D:\123\总结测试3.xls") '指定excel文档路径
set xlsSheet = x1sApp.Workbooks(1).Worksheets("sheet1") '指定要打开的sheet名称
Else
HaveExcel = False
End If
a x1sApp, mdl,x1sApp,xlsWorkBook,xlsSheet
sub a(x1, mdl,x1sApp,xlsWorkBook,xlsSheet)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count
dim rowCount
tableName = ""
rowCount = xlsSheet.usedRange.Rows.Count
on error Resume Next
For rwIndex = 2 To rowCount '指定要遍历的Excel行标 由于第1行是表头,从第2行开始
With xlsSheet
If .Cells(rwIndex, 2).Value = "" Then '如果遍历到第2列为空,则退出
Exit For
End If
If tableName <> .Cells(rwIndex,2) Then '如果表名不同,则表示新建表
set table = mdl.Tables.CreateNew '创建表
table.Name = lcase(.Cells(rwIndex , 2).Value) '指定表名,第2列的值
table.Code = .Cells(rwIndex , 2).Value
count = count + 1
tableName = .Cells(rwIndex,2) '获取表名
end if
set col = table.Columns.CreateNew '创建一列/字段
'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"
if .Cells(rwIndex,4).Value = "" then '指定列名,如果备注不为空,则用备注信息,否则用code的全小写信息
col.Name = lcase(.Cells(rwIndex, 3).Value)
else
col.Name = .Cells(rwIndex,4).Value
end if
'MsgBox col.Name, vbOK + vbInformation, "列"
col.Code = .Cells(rwIndex, 3).Value '指定列编码
col.DataType = .Cells(rwIndex, 6).Value '指定列数据类型
'MsgBox col.DataType, vbOK + vbInformation, "列类型"
col.Comment = .Cells(rwIndex,5).Value '指定列说明
if .Cells(rwIndex, 7).Value = "Y" Then '设置主键信息,Y为主键
col.Primary = true
End If
if .Cells(rwIndex, 9).Value = "Y" Then '设置主键自增长,Y为自增
col.Identity = true
End If
If.Cells(rwIndex, 8).Value = "N" Then '设置非空属性,N为非空
col.Mandatory =true
End If
End With
Next
MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表"
xlsWorkBook.Close
x1sApp.Quit
set x1sApp = nothing
set xlsWorkBook = nothing
Exit Sub
End sub
结果截图: