使用VBA根据数据库表设计文档自动生成建表SQL(oracle)

一般项目都有自己的数据库设计表文档，根据这些文档，使用VBA可以很方便且准确的自动生成建表SQL(oracle)

下面是VBA代码：

Option Explicit
' 所有要写入文件的数据
Dim alldata() As String

' 表字段设定注释数组数据
Dim columnsCommentsArray() As String


' 数据所在单元格ID
' 物理表名ID
Const physicsTableNameRangeId = "C5"
' 表名称ID
Const tableNameRangeId = "C6"

' 列名(中文说明)所在列ID，例如：姓名
Const columnNameId = "B"
' 列名（物理）所在列ID，例如：NAME
Const physicsColumnNameId = "C"
' Data属性所在列ID，例如：NUMBER
Const dateTypeId = "D"
' 长度所在列ID，例如：3, 0
Const lengthId = "E"
' key所在列ID，例如：PK
Const keyId = "F"
' 是否可以为空ID，例如：NOT NULL
Const notNullId = "G"
' 默认值ID，例如：0
Const defaultValueId = "H"

' 1个空格
Const space1 = " "
' 2个空格
Const space2 = "  "
' 5个空格
Const space5 = "     "

' 数据值
' 物理表名数据
Dim physicsTableNameRangeValue As String
' 表名称数据
Dim tableNameRangeValue As String

' 列名(中文说明)所在列数据
Dim columnNameValue As String
' 列名（物理）所在列数据
Dim physicsColumnNameValue As String
' Data属性所在列数据
Dim dateTypeValue As String
' 长度所在列数据
Dim lengthValue As String
' key所在列数据
Dim keyValue As String
' 是否可以为空数据
Dim notNullValue As String
' 默认值数据
Dim defaultValueValue As String

' 列定义开始行
Const startIndex = 9
Const endIndex = 2000

' 主键字符串
Dim keyColumn As String

' -------------------------------
'      制作创建表SQL入口方法
' -------------------------------
Sub makeCreateTableSql()

    ' 物理表名数据
    physicsTableNameRangeValue = Range(physicsTableNameRangeId).Value
    ' 表名称数据
    tableNameRangeValue = Range(tableNameRangeId).Value

    ' 初始化数组
    initAlldataArray ("-- Create table")

    createTableColumnsPartData
    createTablespacePartData
    createTableCommentsPartData
    createColumnsCommentsPartData
    createTableKeyPartData

    writeFile ("C:\")
    
End Sub
' 创建表定义部分数据
'create table TABLE_NAME
'(
'  COL1      VARCHAR2(10) not null,
'  COL2      DATE
')
Function createTableColumnsPartData()
    addLineData ("create table " & physicsTableNameRangeValue)
    addLineData ("(")
    ' 创建表列定义行数据
    makeTableColumnsDetail
    addLineData (")")
    addLineData ("")
End Function
' 创建表空间定义
'tablespace USERS
'  pctfree 10
'  initrans 1
'  maxtrans 255
'  storage
'  (
'    initial 64K
'    minextents 1
'    maxextents unlimited
'  );
Function createTablespacePartData()
    addLineData ("tablespace USERS")
    addLineData ("  pctfree 10")
    addLineData ("  initrans 1")
    addLineData ("  maxtrans 255")
    addLineData ("  storage")
    addLineData ("  (")
    addLineData ("    initial 64K")
    addLineData ("    minextents 1")
    addLineData ("    maxextents unlimited")
    addLineData ("  );")
    addLineData ("")
End Function
' 创建表注释
' -- Add comments to the table
' comment on table TABLE_NAME is '表名称';
Function createTableCommentsPartData()
    addLineData ("-- Add comments to the table")
    addLineData ("comment on table " & physicsTableNameRangeValue & " is '" & tableNameRangeValue & "';")
    addLineData ("")
End Function
' 创建表字段注释
' -- Add comments to the columns
' comment on column TABLE_NAME.COL1 is '字段1';
Function createColumnsCommentsPartData()
    Dim i As Integer
    For i = 0 To UBound(columnsCommentsArray)
        addLineData (columnsCommentsArray(i))
    Next i
End Function
' 创建主键
'-- Create/Recreate primary, unique and foreign key constraints
'alter table TABLE_NAME
'  add primary key (COL1, COL2)
'  using index
'  tablespace USERS
'  pctfree 10
'  initrans 2
'  maxtrans 255
'  storage
'  (
'    initial 64K
'    minextents 1
'    maxextents unlimited
'  );
Function createTableKeyPartData()
    If keyColumn <> "" Then
        ' 去掉主键字符串最后的“,”
        keyColumn = Left(keyColumn, Len(keyColumn) - 1)

        addLineData ("-- Create/Recreate primary, unique and foreign key constraints")
        addLineData ("alter table " & physicsTableNameRangeValue)
        addLineData ("  add primary key (" & keyColumn & ")")
        addLineData ("  using index")
        addLineData ("  tablespace USERS")
        addLineData ("  pctfree 10")
        addLineData ("  initrans 2")
        addLineData ("  maxtrans 255")
        addLineData ("  storage")
        addLineData ("  (")
        addLineData ("    initial 64K")
        addLineData ("    minextents 1")
        addLineData ("    maxextents unlimited")
        addLineData ("  );")
    End If
End Function
' 创建表列定义行数据
'  COL1     VARCHAR2(10) not null,
'  COL2     VARCHAR2(100),
'  COL3     NUMBER(19),
'  COL4     DATE,
'  COL5     NUMBER(5,2),
'  COL6     VARCHAR2(100),
'  COL7     CHAR(1) default 0,
'
Function makeTableColumnsDetail()
    Dim i As Integer
    Dim columnLine As String
    
    ' 初始化表字段设定注释数组
    initColumnsCommentsArray ("-- Add comments to the columns")
    
    ' 主键字符串
    keyColumn = ""
    For i = startIndex To endIndex
    
        
        ' 列名（物理）所在列数据
        physicsColumnNameValue = Trim(Range(physicsColumnNameId & CStr(i)).Value)
        
        If physicsColumnNameValue <> "" Then
            ' 列名(中文说明)所在列数据
            columnNameValue = Trim(Range(columnNameId & CStr(i)).Value)
            
            ' 向表字段设定注释数组中添加新行
            ' comment on column TABLE_NAME.COL1 is '字段1';
            addColumnsCommentsLineData ("comment on column " & physicsTableNameRangeValue & "." & physicsColumnNameValue & " is '" & columnNameValue & "';")
            
            ' Data属性所在列数据
            dateTypeValue = Trim(Range(dateTypeId & CStr(i)).Value)
            ' 长度所在列数据
            lengthValue = Trim(Range(lengthId & CStr(i)).Value)
            ' key所在列数据
            keyValue = Trim(Range(keyId & CStr(i)).Value)
            ' 是否可以为空数据
            notNullValue = Trim(Range(notNullId & CStr(i)).Value)
            ' 默认值数据
            defaultValueValue = Trim(Range(defaultValueId & CStr(i)).Value)

            ' 取得主键字符串
            If UCase(keyValue) = "PK" Then
                keyColumn = keyColumn & physicsColumnNameValue & ","
            End If
            
            ' 得到类似 "  COL1     "
            columnLine = space2 & physicsColumnNameValue & space5
            
            ' 得到类似 "VARCHAR2(10) "
            If dateTypeValue = "VARCHAR2" Then
                columnLine = columnLine & "VARCHAR2(" & lengthValue & ")" & space1
            ElseIf dateTypeValue = "NUMBER" Then
                columnLine = columnLine & "NUMBER(" & Replace(lengthValue, "，", ",") & ")" & space1
            ElseIf dateTypeValue = "DATE" Then
                columnLine = columnLine & "DATE" & space1
            ElseIf dateTypeValue = "CHAR" Then
                columnLine = columnLine & "CHAR(" & lengthValue & ")" & space1
            End If
            
            ' 默认值数据, 得到类似 ""
            If defaultValueValue <> "" Then
                columnLine = columnLine & "default" & space1 & defaultValueValue & space1
            End If
            
            ' 是否可以为空数据, 得到类似 "not null"
            If UCase(notNullValue) = "NOT NULL" Then
                columnLine = columnLine & "not null"
            End If
        
            ' 每个字段行追加一个,
            columnLine = columnLine & ","
            addLineData (columnLine)
        Else
            ' 去掉字符串最后的“,”
            alldata(UBound(alldata)) = Left(alldata(UBound(alldata)), Len(alldata(UBound(alldata))) - 1)
            Exit For
        End If
        
    Next i

    ' 向表字段设定注释数组中添加新行
    addColumnsCommentsLineData ("")
End Function
' ----------------------------以下为写文件和操作数组方法----------------------------
' 写文件
' path 路径名 例如："C:\"
Function writeFile(ByVal path As String)
  ' 循环计数器
  Dim i As Integer
  Dim fullPath As String
  fullPath = path + physicsTableNameRangeValue + ".sql"
  Open fullPath For Output As #1
  For i = 0 To UBound(alldata)
    Print #1, alldata(i)
  Next i
  ' 关闭 Open 语句打开的所有活动文件，并将文件缓冲区的所有内容写入磁盘。
  Reset

End Function

' 弹出完成信息
Function showFinishMessage()
  MsgBox "成功作成"
End Function
' 初始化数组
Function initAlldataArray(ByVal data As String)
  ' 初始化数组
  ReDim Preserve alldata(0)
  alldata(0) = data
End Function
' 向数组中添加新行
Function addLineData(ByVal data As String)
  ReDim Preserve alldata(UBound(alldata) + 1)
  alldata(UBound(alldata)) = data
End Function

' -----------------------------
' 初始化表字段设定注释数组
Function initColumnsCommentsArray(ByVal data As String)
  ' 初始化数组
  ReDim Preserve columnsCommentsArray(0)
  columnsCommentsArray(0) = data
End Function
' 向表字段设定注释数组中添加新行
Function addColumnsCommentsLineData(ByVal data As String)
  ReDim Preserve columnsCommentsArray(UBound(columnsCommentsArray) + 1)
  columnsCommentsArray(UBound(columnsCommentsArray)) = data
End Function

生成的TABLE_TEST.sql文件内容如下所示：

-- Create table
create table TABLE_TEST
(
  USERID     VARCHAR2(20) not null,
  USERNAME     VARCHAR2(100) ,
  AGE     NUMBER(3) default 18 not null,
  SEX     default 1 not null,
  DELETEFLAG     CHAR(1) default 0 not null,
  CREATEDATE     DATE ,
  CREATEUSER     VARCHAR2(20) ,
  UPDATEDATE     DATE ,
  UPDATEUSER     VARCHAR2(20) 
)

tablespace USERS
  pctfree 10
  initrans 1
  maxtrans 255
  storage
  (
    initial 64K
    minextents 1
    maxextents unlimited
  );

-- Add comments to the table
comment on table TABLE_TEST is '制作表SQL测试表';

-- Add comments to the columns
comment on column TABLE_TEST.USERID is '用户ID';
comment on column TABLE_TEST.USERNAME is '用户名称';
comment on column TABLE_TEST.AGE is '年龄';
comment on column TABLE_TEST.SEX is '性别';
comment on column TABLE_TEST.DELETEFLAG is '删除标志';
comment on column TABLE_TEST.CREATEDATE is '创建时间';
comment on column TABLE_TEST.CREATEUSER is '创建人ID';
comment on column TABLE_TEST.UPDATEDATE is '更新时间';
comment on column TABLE_TEST.UPDATEUSER is '更新人ID';

-- Create/Recreate primary, unique and foreign key constraints
alter table TABLE_TEST
  add primary key (USERID)
  using index
  tablespace USERS
  pctfree 10
  initrans 2
  maxtrans 255
  storage
  (
    initial 64K
    minextents 1
    maxextents unlimited
  );