根据Word表格自动生成SQL数据库脚本的VBScript代码

 

       这是几年前写的根据Word表格自动生成SQL数据库脚本的VBScript代码，最近修改了下（原来只支持单个Word表格）使其支持一个Word文档中的多个表格，生成的SQL文件名以Word文件名+.SQL，并和Word文档存放在同一目录下（如果需要更改文件名或目录请修改sSQLFileName 变量），另外表格需要使用规定的格式（见附件），如果更换表格格式当然也同时修改代码了。

Sub CreateSQLFile()
'
' CreateSQLFile Macro
' 宏在 2005-4-15 由 czl 创建
'
         ' 数组声明
         ' 有缺省值有字段数组
         Dim DefaultFieldArr( 35 , 1 ) As String
         ' 主键字段数组
         Dim PKFieldArr( 10 ) As String
         ' 缺省数组长度
         Dim DefaultArrLen As Integer
         ' 主键数组长度
         Dim PKArrLen As Integer
         ' 上一行
         Dim sPreLine As String
         ' 是否有文本图像字段
         Dim bHasTextImageField As Boolean
         ' 循环变量
         Dim i As Integer
         ' 最大字段描述行
         Dim iMaxLine As Integer
         ' 文档表总数
         Dim iTableCount As Integer
        
         ' 脚本文件保存路径
         ' sSQLFileSavePath = "E:/Hugesoft/表设计/Scripts/"
         ' 脚本文件名
        sSQLFileName = ActiveDocument.FullName + " .SQL "
         ' 创建文件
         Set fs = CreateObject ( " Scripting.FileSystemObject " )
         Set a = fs.CreateTextFile(sSQLFileName, True )
        
        iTableCount = ActiveDocument.Tables.Count
         For iIndex = 1 To iTableCount
        
                 ' 取得表名
                 Set oTable = ActiveDocument.Tables(iIndex)
                 Set aCell = oTable.Rows( 4 ).Cells( 2 )
                 Set myRange = ActiveDocument.Range(Start: = aCell.Range.Start, _
                         End : = aCell.Range.End - 1 )
                sTableName = myRange.Text
                
                 ' 取表格的总行数
                iRowCount = oTable.Rows.Count
                
                DefaultArrLen = 0
                PKArrLen = 0
                sPreLine = ""
                bHasTextImageField = False
                
                 ' 写入脚本文件
                a.WriteLine ( " if exists (select * from dbo.sysobjects where id = object_id(N'[dbo].[ " + sTableName + " ]') and OBJECTPROPERTY(id, N'IsUserTable') = 1) " )
                a.WriteLine ( " drop table [dbo].[ " + sTableName + " ] " )
                a.WriteLine ( " GO " )
                a.WriteLine ( "" )
                a.WriteLine ( " CREATE TABLE [dbo].[ " + sTableName + " ] ( " )
                
                 For i = 9 To iRowCount
                        sLine = ""
                         ' 取得字段名
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 2 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 2 ).Range.End - 1 )
                        sFieldName = myRange.Text
                         If sFieldName = "" Then
                                 Exit For
                         End If
                         ' 取得数据类型
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 4 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 4 ).Range.End - 1 )
                        sFieldType = myRange.Text
                        sFieldType = StrConv(sFieldType, vbLowerCase)
                        
                         ' 取得字段长度
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 5 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 5 ).Range.End - 1 )
                        sFieldLen = myRange.Text
                         ' 取得小数位数
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 6 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 6 ).Range.End - 1 )
                        sFieldDigLen = myRange.Text
                         ' 取得缺省值
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 7 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 7 ).Range.End - 1 )
                        sFieldDefaultValue = myRange.Text
                         ' 取得允许空值
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 8 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 8 ).Range.End - 1 )
                        sFieldAllowNull = myRange.Text
                         ' 取得是否主键
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 9 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 9 ).Range.End - 1 )
                        sFieldIsPKey = myRange.Text
                        
                         ' 是否有文本图像字段
                         If sFieldType = " text " Or sFieldType = " ntext " Or sFieldType = " image " Then
                                bHasTextImageField = True
                         End If
                        
                         ' 是否主键字段
                         If sFieldIsPKey = " √ " Then
                                PKFieldArr(PKArrLen) = sFieldName
                                PKArrLen = PKArrLen + 1
                         End If
                        
                         ' 是否有缺省值
                         If sFieldDefaultValue <> "" Then
                                 ' 处理全角字符
                                iLen = Len (sFieldDefaultValue)
                                 If iLen >= 2 Then
                                         If Left (sFieldDefaultValue, 1 ) = " ‘ " Then
                                                sFieldDefaultValue = Chr ( 39 ) + Mid (sFieldDefaultValue, 2 , iLen - 2 ) + Chr ( 39 )
                                         End If
                                 End If
                                
                                DefaultFieldArr(DefaultArrLen, 0 ) = sFieldName
                                DefaultFieldArr(DefaultArrLen, 1 ) = sFieldDefaultValue
                                DefaultArrLen = DefaultArrLen + 1
                         End If
                        
                         ' 生成行
                        sLine = Chr ( 9 ) + " [ " + sFieldName + " ] [ " + sFieldType + " ] "
                        
                         If sFieldType = " varchar " Or sFieldType = " nvarchar " Then
                                sLine = sLine + " ( " + sFieldLen + " ) "
                         End If
                        
                         If sFieldType = " numeric " Then
                                sLine = sLine + " ( " + sFieldLen + " , " + sFieldDigLen + " ) "
                         End If
                        
                         If sFieldDigLen = " * " Then
                                 ' 表示该列自动增长，一般作主键用
                                sLine = sLine + " IDENTITY (1, 1) "
                         End If
                        
                         If (sFieldType = " varchar " ) Or (sFieldType = " nvarchar " ) Or (sFieldType = " text " ) Or ((sFieldType = " ntext " )) Then
                                sLine = sLine + " COLLATE Chinese_PRC_CI_AS "
                         End If
                        
                         If sFieldAllowNull = " √ " Then
                                sLine = sLine + " NULL "
                         Else
                                sLine = sLine + " NOT NULL "
                         End If
                        
                         If sPreLine <> "" Then
                                a.WriteLine (sPreLine + " , " )
                         End If
                        
                        sPreLine = sLine
                 Next i
                
                iMaxLine = i
                
                 If sPreLine <> "" Then
                        a.WriteLine (sPreLine)
                 End If
                
                 If bHasTextImageField Then
                        a.WriteLine ( " ) ON [PRIMARY] TEXTIMAGE_ON [PRIMARY] " )
                 Else
                        a.WriteLine ( " ) ON [PRIMARY] " )
                 End If
                a.WriteLine ( " GO " )
                a.WriteLine ( "" )
                
                 ' 生成主键描述
                a.WriteLine ( " ALTER TABLE [dbo].[ " + sTableName + " ] WITH NOCHECK ADD " )
                a.WriteLine ( Chr ( 9 ) + " CONSTRAINT [PK_ " + sTableName + " ] PRIMARY KEY CLUSTERED " )
                a.WriteLine ( Chr ( 9 ) + " ( " )
                
                sPreLine = ""
                 For i = 0 To PKArrLen - 1
                        sLine = Chr ( 9 ) + Chr ( 9 ) + " [ " + PKFieldArr(i) + " ] "
                         If sPreLine <> "" Then
                                a.WriteLine (sPreLine + " , " )
                         End If
                        sPreLine = sLine
                 Next i
                 If sPreLine <> "" Then
                        a.WriteLine (sPreLine)
                 End If
                a.WriteLine ( Chr ( 9 ) + " ) ON [PRIMARY] " )
                a.WriteLine ( " GO " )
                a.WriteLine ( "" )
                
                 ' 生成缺省值描述
                 If DefaultArrLen > 0 Then
                        a.WriteLine ( " ALTER TABLE [dbo].[ " + sTableName + " ] WITH NOCHECK ADD " )
                        sPreLine = ""
                         For i = 0 To DefaultArrLen - 1
                                sLine = Chr ( 9 ) + " CONSTRAINT [DF_ " + sTableName + " _ " + DefaultFieldArr(i, 0 ) + " ] DEFAULT ( " + DefaultFieldArr(i, 1 ) + " ) FOR [ " + DefaultFieldArr(i, 0 ) + " ] "
                                 If sPreLine <> "" Then
                                        a.WriteLine (sPreLine + " , " )
                                 End If
                                sPreLine = sLine
                         Next i
                         If sPreLine <> "" Then
                                a.WriteLine (sPreLine)
                         End If
                        a.WriteLine ( " GO " )
                        a.WriteLine ( "" )
                 End If
                
                 ' 生成索引描述
                 ' 查找索引描述开始行
                iIndexStartLine = 0
                
                 For i = iMaxLine To iRowCount
                         Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 1 ).Range.Start, _
                                 End : = oTable.Rows(i).Cells( 1 ).Range.End - 1 )
                        sTmp = myRange.Text
                         If sTmp = " 索引组成： " Then
                                iIndexStartLine = i
                                 Exit For
                         End If
                 Next i
                
                 ' 生成索引描述
                 If iIndexStartLine > 0 Then
                         For i = iIndexStartLine + 2 To iRowCount
                                 ' 取得索引名称
                                 Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 2 ).Range.Start, _
                                         End : = oTable.Rows(i).Cells( 2 ).Range.End - 1 )
                                sIndexName = myRange.Text
                                 If sIndexName = "" Then
                                         Exit For
                                 End If
                                 ' 取得索引列序列
                                 Set myRange = ActiveDocument.Range(Start: = oTable.Rows(i).Cells( 3 ).Range.Start, _
                                         End : = oTable.Rows(i).Cells( 3 ).Range.End - 1 )
                                sIndexFieldList = myRange.Text
                                 ' 写入文件
                                a.WriteLine ( " CREATE UNIQUE INDEX [ " + sIndexName + " ] ON [dbo].[ " + sTableName + " ]( " + sIndexFieldList + " ) ON [PRIMARY] " )
                                a.WriteLine ( " GO " )
                         Next i
                 End If
         Next iIndex
        
        a.Close
        
         MsgBox " 成功生成脚本文件： " + Chr ( 13 ) + Chr ( 9 ) + sSQLFileName + " 。 "
End Sub

       使用方法：点Word菜单“工具→宏→宏”，单击弹出对话框中右侧的“创建”，进入编辑器后把下面的代码复制粘贴覆盖缺省生成的代码，完成后可以通过Word工具栏的自定义功能把宏放在工具栏，方便使用。

 

       标准Word表格请到炬源信息技术网（http://www.hugesoft.net/）下载。