excle数据结构生成物理模型

执行VB脚本：

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
RQ = vbYes 'MsgBox("Is Excel Installed on your machine ?", vbYesNo + vbInformation, "Confirmation")
If RQ = vbYes Then
HaveExcel = True
'Open & Create Excel Document
Dim x1
Set x1 = CreateObject("Excel.Application")
x1.Application.Visible = True
x1.Workbooks.Open "C:UsersAdministratorDesktopook1.xlsx"'excel所在位置
x1.Workbooks(1).Worksheets("Sheet1").Activate'活动的sheet
Else
HaveExcel = False
End If




a x1, mdl

sub a(x1, mdl)
dim rwIndex
dim tableName
dim colname
dim table
dim col
dim count

dim shtIdx
for shtIdx=1 to x1.Workbooks(1).Worksheets.Count
on error Resume Next

With x1.Workbooks(1).Worksheets(shtIdx)
If .Cells(1, 1).Value = "PrpLregist" Then'判断表
count = count + 1
set table = mdl.Tables.CreateNew
table.Code = .Cells(1, 1).Value'表编码（对应excel的位置）
table.Name = .Cells(1, 2).Value'表名
table.Comment = .Cells(1, 3).Value'描述

For rwIndex = 3 To 255'从第三列开始
If .Cells(rwIndex, 3).Value <> "" Then'类型不为空的
set col = table.Columns.CreateNew
col.Name = .Cells(rwIndex, 1).Value'字段名
col.Code = .Cells(rwIndex, 2).Value'字段编码
col.Comment = .Cells(rwIndex, 8).Value'字段描述所在列
col.DataType = .Cells(rwIndex, 3).Value'数据类型
If.Cells(rwIndex, 8).Value = "PRI" Then'指定主键
col.Primary =true
End If
If.Cells(rwIndex, 7).Value = "Y" Then'指定列是否可空 true 为不可空
col.Mandatory =true
End If
End If
Next
End If
End With


Next

x1.Application.Quit
Set x1=Nothing

MsgBox "生成数据表结构共计 " + CStr(count), vbOK + vbInformation, "表"
End sub