Option Explicit
Dim shet, cnt
' ---------------------------------------------------
' For each shet in array("Sheet1", "Sheet2", "Sheet3"... )
' ---------------------------------------------------
Dim ind
For ind = 2 To 5 '根据工作簿中Sheet的个数修改,Sheet2~Sheet5
shet = "Sheet" & ind
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:\CMSDB.xls") '修改为对应Excel路径,注意后缀必须一样
set xlsSheet = x1sApp.Workbooks(1).Worksheets(shet) '指定要打开的sheet名称
Else
HaveExcel = False
End If
a mdl,x1sApp,xlsWorkBook,xlsSheet
cnt = cnt + 1
Next
MsgBox "生成数据表结构共计 " + CStr(cnt), vbOK + vbInformation, "表"
sub a(mdl,x1sApp,xlsWorkBook,xlsSheet)
dim rwIndex
dim table
dim col
dim rowCount
rowCount = xlsSheet.usedRange.Rows.Count
on error Resume Next
For rwIndex = 2 To rowCount '指定要遍历的Excel行标 第1行是表头
With xlsSheet
If .Cells(rwIndex, 2).Value = "" Then '如果遍历到第二列为空,则退出
Exit For
End If
If .Cells(rwIndex, 3).Value = "" Then '如果遍历到第三列为空,则此行为表名
set table = mdl.Tables.CreateNew '创建表
table.Name = .Cells(rwIndex , 1).Value '指定表名,第1列的值
table.Code = .Cells(rwIndex , 2).Value
table.Comment = .Cells(rwIndex , 1).Value '指定表注释,第一列的值
Else
set col = table.Columns.CreateNew '创建一列/字段
'MsgBox .Cells(rwIndex, 1).Value, vbOK + vbInformation, "列"
col.Name = .Cells(rwIndex, 1).Value '指定列:字段名
'MsgBox col.Name, vbOK + vbInformation, "列"
col.Code = .Cells(rwIndex, 2).Value '指定列:字段编码
col.DataType = .Cells(rwIndex, 3).Value '指定列:字段数据类型
'MsgBox col.DataType, vbOK + vbInformation, "列类型"
If .Cells(rwIndex, 4).Value = "" Then
col.Comment = .Cells(rwIndex, 1).Value
Else
col.Comment = .Cells(rwIndex, 4).Value '指定列:字段说明
End If
if col.Code = "id" Then
col.Identity = true
End If
if col.Code = "ID" Then
col.Identity = true
End If
if .Cells(rwIndex, 4).Value = "Primary Key" Then
col.Primary = true
End If
'If .Cells(rwIndex, 5).Value = "NOT NULL" Then
' col.Mandatory =true
'End If
End If
End With
Next
xlsWorkBook.Close
x1sApp.Quit
set x1sApp = nothing
set xlsWorkBook = nothing
Exit Sub
End sub