数据字典到SQL语句的转换(使用word与VBA)

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