03-VB脚本将EXCEL转换为PDM

需求：将格式化后的EXCEL自动转为PDM。避免手动构建数据模型。支持新建数模和更新原有数模。

1.EXCEL模板

2.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
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("C:\Users\Administrator\Desktop\VB源.xlsx")   '指定excel文档路径
    set xlsSheet = x1sApp.Workbooks(1).Worksheets("vb")   '指定要打开的sheet名称
Else
    HaveExcel = False
End If

a x1sApp, mdl,x1sApp,xlsWorkBook,xlsSheet


private function isNoExitTable(model,tableCode)
  dim tables
  dim table
  dim flag
  set tables = model.Tables
  flag = true
  for each table in tables

      if table.Code=tableCode then 
         
         flag = false
       end if
       
   next
   isNoExitTable = flag
end function



private sub updateTbale(model,tableCode,a5,a4,a7,a6,a8,a9,a10)

  dim tables
  dim table
  dim col
  dim tempTable
  set tables = model.Tables
  for each table in tables
      if table.Code=tableCode then 
         set col = table.Columns.CreateNew   '创建一列/字段
         if a5.Value  = "" then    '指定列名，如果备注不为空，则用备注信息，否则用code的全小写信息
             col.Name = lcase(a4.Value)   
         else
             col.Name = a5.Value
         end if

         col.Code = a4.Value   '指定列编码
         col.DataType = a7.Value '指定列数据类型
         col.Comment = a6.Value  '指定列说明

         if a8.Value = "Y" Then    '设置主键信息
             col.Primary = true
         End If

         if a10.Value = "Y" Then    '设置主键自增长
             col.Identity = true
         End If

         IF a9.Value = "NO" Then    '设置非空属性
             col.Mandatory =true

         End IF  
       end if
       
   next
   
end sub

sub a(x1, mdl,x1sApp,xlsWorkBook,xlsSheet)
     dim currentTable
    dim rwIndex
    dim tableName
    dim colname
    dim table
    dim indexTable
    dim col
    dim count
    dim rowCount
    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 isNoExitTable(mdl,.Cells(rwIndex,1)) Then  
                set table = mdl.Tables.CreateNew     '创建表
               
                table.Name = .Cells(rwIndex , 2)'指定表名，第2列的值
                table.Code = .Cells(rwIndex , 1)
                table.Comment = .Cells(rwIndex , 3) '指定表注释，第3列的值
                count = count + 1
                currentTable = table.Code
                
                 set col = table.Columns.CreateNew   '创建一列/字段
                 
               if .Cells(rwIndex,5).Value  = "" then    '指定列名，如果备注不为空，则用备注信息，否则用code的全小写信息
                   col.Name = lcase(.Cells(rwIndex, 4).Value)   
               else
                   col.Name = .Cells(rwIndex,5).Value
               end if
 
               col.Code = .Cells(rwIndex, 4).Value   '指定列编码
               col.DataType = .Cells(rwIndex, 7).Value '指定列数据类型
               col.Comment = .Cells(rwIndex,6).Value  '指定列说明

               if .Cells(rwIndex, 8).Value = "Y" Then    '设置主键信息
                   col.Primary = true
               End If

               if .Cells(rwIndex, 10).Value = "Y" Then    '设置主键自增长
                   col.Identity = true
               End If
            
               IF.Cells(rwIndex, 9).Value = "NO" Then    '设置非空属性
                   col.Mandatory =true
           
               End IF    
            
                
                
             ELSE
                IF currentTable = .Cells(rwIndex,1) Then
                 
                  set col = table.Columns.CreateNew   '创建一列/字段
                  if .Cells(rwIndex,5).Value  = "" then    '指定列名，如果备注不为空，则用备注信息，否则用code的全小写信息
                      col.Name = lcase(.Cells(rwIndex, 4).Value)   
                  else
                      col.Name = .Cells(rwIndex,5).Value
                  end if
 
                  col.Code = .Cells(rwIndex, 4).Value   '指定列编码
                  col.DataType = .Cells(rwIndex, 7).Value '指定列数据类型
                  col.Comment = .Cells(rwIndex,6).Value  '指定列说明

                  if .Cells(rwIndex, 8).Value = "Y" Then    '设置主键信息
                      col.Primary = true
                  End If

                  if .Cells(rwIndex, 10).Value = "Y" Then    '设置主键自增长
                      col.Identity = true
                  End If
            
                  IF.Cells(rwIndex, 9).Value = "NO" Then    '设置非空属性
                      col.Mandatory =true
           
                  End IF    
                 
                else 
                  updateTbale mdl,.Cells(rwIndex,1),.Cells(rwIndex,5),.Cells(rwIndex,4),.Cells(rwIndex,7),.Cells(rwIndex,6),.Cells(rwIndex,8),.Cells(rwIndex,9),.Cells(rwIndex,10)

                end if
               
             END IF
        End With
    Next

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

    xlsWorkBook.Close
    x1sApp.Quit

    set x1sApp = nothing
    set xlsWorkBook = nothing

    Exit Sub

End sub