excel表结构通过vb导入到pdm里

Dim mdl ' thecurrent model

Set mdl =ActiveModel

If (mdl Is Nothing) Then

    MsgBox "没有活动的模版"

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.Workbooks.Open"C:\Users\zhfeng\Desktop\pdm.xlsx" '指定excel文档路径

Else

HaveExcel =False

End If

 

call a(x1, mdl)

 

sub a(x1, mdl)

dim rwIndex

dim tableName

dim colname

dim table

dim col

dim count,total,sheet

 

on error Resume Next

for total = 1 to 100
set sheet = nothing
 
set sheet = x1.Workbooks(1).Worksheets("Sheet"+cstr(total))
	 

 With sheet '需要循环的sheet名称  
 
   if .cells(1,1).value = "" then
      exit for
   end if   



	
	set table = mdl.Tables.CreateNew '创建一个表实体
	
	table.Name =.cells(1,1).value '指定表名，如果在Excel文档里有，也可以 .Cells(rwIndex, 3).Value 这样指定
	
	table.comment =.cells(1,1).value
	
	table.Code =.cells(1,2).value'指定表名编码





count = count +1

For rwIndex = 3 To 1000 '指定要遍历的Excel行标，此处第一列为列名，古从第二行开始循环



If.Cells(rwIndex, 1).Value = "" Then

Exit For

End If

 

set col =table.Columns.CreateNew '创建一列/字段

 

col.Name =.Cells(rwIndex, 1).Value '指定列名

 

col.Code =.Cells(rwIndex, 2).Value '指定列名编码

 

col.DataType =.Cells(rwIndex, 3).Value '指定列数据类型

 

col.Length =.Cells(rwIndex, 4).Value '指定字段长度

 

col.Precision =cint(.Cells(rwIndex, 5).Value) '指定字段长度

 

'指定主键

If.Cells(rwIndex, 6).Value = "Y" Then

col.Primary =true

End If

 

'指定列是否可空 true 为不可空

If.Cells(rwIndex, 7).Value = "N" Then

col.Mandatory =true

End If

 

col.Comment =.Cells(rwIndex, 8).Value '指定列说明


Next

End With

next

set mdl = Nothing

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

 

 

Exit Sub

End sub