一般我们有几种方式对数据库建模：
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
