一般我们有几种方式对数据库建模：
1.采用PowerDesign或ErWin等建模工具进行建模
2.利用WORD或EXCEL进行建模
使用第一种方式，可以自动导出要生产表的SQL语句，建表比较方便，而对于第二种方式，则可能需要手工建表，其实在WORD中可以用VBA完成对SQL语句的生成，如将下面格式的WORD数据字典生成SQL语句，就可以利用VBA进行
WORD文档样式为：
|
| Table1 |
|
|
|
|
|
|
| PK | 默认值 |
| Field1 |
| Varchar(50) | 是 | 1 |
| Field2 |
| Int |
|
|
| Field3 |
| Int |
|
|
| Field4 |
| Numeric(18,4) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Function GetCreateStr() Dim docOld As Document Dim rngDoc As Range Dim tblDoc As Table Dim i As Integer, iIndex1 As Integer, iIndex2 As Integer Dim myCell As Cell Dim sTemp As String, sTemp1 As String, sTemp2 As String Dim sHead As String Dim sResult As String, sLength As String Dim sDou As String, s1 As String Dim sDou1 As String, sKey As String Dim sTableName As String sDou = """": sDou1 = "'" If ActiveDocument.Tables.Count >= 1 Then For i = 1 To ActiveDocument.Tables.Count sTableName = ActiveDocument.Tables(i).Cell(1, 2).Range.Text sTableName = Mid(sTableName, 1, Len(sTableName) - 2) s1 = "USE [SocialKey]" & vbCrLf & vbCrLf & "GO " & vbCrLf & vbCrLf & _ "/****** 对象: Table [dbo].[" & sTableName & "] 脚本日期: " & Now & _ "******/" & vbCrLf & vbCrLf & _ "SET ANSI_NULLS ON " & vbCrLf & vbCrLf & _ "SET QUOTED_IDENTIFIER ON " & vbCrLf & _ "GO " & vbCrLf sHead = s1 & vbctrl & "if exists (select * from dbo.sysobjects where id = object_id(N" & sDou1 & _ "[dbo].[" & sTableName & "]" & sDou1 & ") and OBJECTPROPERTY(id, N" & sDou1 & _ "IsUserTable" & sDou1 & ") = 1)" & vbCrLf & _ vbTab & " drop table [dbo].[" & sTableName & "]" & vbCrLf & _ "GO" & vbCrLf & _ "CREATE TABLE [dbo].[" & sTableName & "] (" sTemp = "": sResult = "" For j = 3 To ActiveDocument.Tables(i).Rows.Count Set myCell = ActiveDocument.Tables(i).Cell(j, 1) sTemp = Mid(myCell.Range.Text, 1, Len(myCell.Range.Text) - 2) If Trim(sTemp) <> "" Then sTemp = vbTab & "[" & sTemp & "]" Set myCell = ActiveDocument.Tables(i).Cell(j, 3) sTemp1 = Mid(myCell.Range.Text, 1, Len(myCell.Range.Text) - 2) iIndex1 = InStr(sTemp1, "(") If iIndex1 > 0 Then iIndex2 = InStr(sTemp1, ")") sLength = Mid(sTemp1, iIndex1 + 1, iIndex2 - iIndex1 - 1) sTemp1 = Mid(sTemp1, 1, iIndex1 - 1) sTemp2 = "[" & sTemp1 & "]" & " (" & sLength & ")" & " NULL" & "," Else sTemp2 = "[" & sTemp1 & "]" & " NULL" & "," End If sResult = sResult & sTemp & " " & sTemp2 & vbCrLf End If Next j sResult = sHead & vbCrLf & sResult Next i End If sResult = Mid(sResult, 1, Len(sResult) - 3) & vbCrLf & ")" GetCreateStr = sResult 'Debug.Print GetCreateStr End Function Sub StrToFile(sContent As String, sFile As String) Kill sFile '首先删除源文件 Open sFile For Append As #1 '打开文件 Print #1, sContent '写入文件 Close #1 End Sub
Private Sub CommandButton2_Click() Dim sTemp As String, sPath As String sTemp = GetCreateStr 'Debug.Print sTemp sPath = Left(ActiveDocument.Name, Len(ActiveDocument.Name) - 4) 'Debug.Print ActiveDocument.Path & sPath & ".txt" Call StrToFile(sTemp, ActiveDocument.Path & "\" & sPath & ".txt") End Sub