如何根據當前MDB中的表生成對應的JET SQL DDL “CREATE TABLE”語句/腳本？

如何根據當前MDB中的表生成對應的JET SQL DDL “CREATE TABLE”語句/腳本？

作者︰cg1  摘自︰access911.net  編輯︰cg1  更新日期︰2005-12-26  瀏覽人次︰3016

 

問題︰

 如何根據當前MDB中的表生成對應的JET SQL DDL “CREATE TABLE”語句？
如何用這個腳本在一個新的數據庫中新建表？
SQL SERVER可以將表結構導出為 *.SQL 的腳本，這個*.sql腳本里面是一些 "Create table" 語句，ACCESS 能做到么？

 

回答︰

 
Access并未內置將表結構導出為腳本下次能直接建表的功能。

利用 ADOX / ADO / DAO 三個數據訪問模型來獲取對應的信息并組織 JET SQL DDL 語句，生成對應的 *.jetsql 文本文件腳本。再根據上述腳本在一個新的 MDB 數據庫中新建上述表。

注意︰由于 JET SQL DDL 語句并不支持所有的 ADOX / ADO / DAO 屬性，所以有一部分表的屬性，比如“格式”屬性無法通過 JET SQL DDL 語句建立。最完整的解決方案是生成 *.VBA 腳本，而不是 JET SQL 腳本。

Function CreateSQLString(ByVal FilePath As String) As Boolean

'本函數根據當前MDB中的表創建一個 *.jetsql 腳本
'這個函數不是最完美的解決方案，因為 JET SQL DDL 語句不支持一些 ACCESS 特有的屬性（DAO支持）
'This function create a "*.jetsql" script based on current mdb tables.
'This function is not the BEST, because the JET SQL DDL never support some DAO property.

    Dim MyTableName As String
    Dim MyFieldName As String
    
    Dim MyDB As New ADOX.Catalog
    Dim MyTable As ADOX.Table
    Dim MyField As ADOX.Column
    Dim pro
    Dim iC As Long
    
    Dim strField() As String
    Dim strKey As String
    Dim strSQL As String
    Dim strSQLScript As String
    
    Dim objFile, stmFile
    Dim strText As String

On Error GoTo CreateSQLScript_Err
    
    MyDB.ActiveConnection = CurrentProject.Connection
       
    For Each MyTable In MyDB.Tables
        If MyTable.Type = "TABLE" Then
        '指定表的類型，例如“TABLE”、“SYSTEM TABLE”或“GLOBAL TEMPORARY”或者“ACCESS TABLE”。
        'ADOX 無法判斷該表是否已經被刪除，還有兩种方式判斷，
        '方法一︰（用 DAO）
        'If CurrentDb.TableDefs(strTableName).Attributes = 0 Then
        '方法二︰（在判斷 ADOX.Table.Type 的基礎上再判定表名）
        'If Left(MyTable.Name, 7) <> "~TMPCLP" Then
        
            strSQL = "create table [" & MyTable.Name & "]("
            For Each MyField In MyTable.Columns
                ReDim Preserve strField(iC)
                strField(iC) = SQLField(MyField)
                iC = iC + 1
            Next
            strSQL = strSQL & Join(strField, ",")
            '獲取當前表的字段信息後立即重新初始化 strField 數組
            iC = 0
            ReDim strField(iC)
            
            '加入鍵信息
            strKey = SQLKey(MyTable)
            If Len(strKey) <> 0 Then
                strSQL = strSQL & "," & strKey
            End If
            strSQL = strSQL & ");" & vbCrLf
            strSQLScript = strSQLScript & strSQL
            
            'Debug.Print SQLIndex(MyTable)      'Never support the INDEX,to be continued...
            '暫未支持 index 腳本，未完待續...
        End If
        
    Next
    
    
    
    Set MyDB = Nothing

    'create the Jet SQL Script File
    Set objFile = CreateObject("Scripting.FileSystemObject")
    Set stmFile = objFile.CreateTextFile(FilePath, True)
    stmFile.Write strSQLScript
    stmFile.Close
    Set stmFile = Nothing
    Set objFile = Nothing

    CreateSQLScript = True

CreateSQLScript_Exit:
    Exit Function

CreateSQLScript_Err:
    MsgBox Err.Description, vbExclamation
    CreateSQLScript = False
    Resume CreateSQLScript_Exit

End Function

Function RunFromText(ByVal FilePath As String)
'本函數將 CreateSQLScript 生成的 *.jetsql 腳本來生成 mdb 數據庫中的表
'This Function run the "*.jetsql" which is created by CreateSQLScript to create the tables in current mdb database.
On Error Resume Next
    Dim objFile, stmFile
    Dim strText As String
    Set objFile = CreateObject("Scripting.FileSystemObject")
    Set stmFile = objFile.OpenTextFile(FilePath, 1, False)
    strText = stmFile.ReadAll
    stmFile.Close
    Set stmFile = Nothing
    Set objFile = Nothing
    
    Dim strSQL() As String
    Dim i As Long
    strSQL = Split(strText, ";" & vbCrLf)
    For i = LBound(strSQL) To UBound(strSQL)
        CurrentProject.Connection.Execute Trim(strSQL(i))
        If Err <> 0 Then
            Debug.Print "Error SQL is:" & strSQL(i)
            Err.Clear
        End If
    Next
End Function

Function SQLKey(ByVal objTable As ADOX.Table)
'調用 ADOX 生成有關“鍵”的 JET SQL DDL 子句
'Reference ADOX and create the JET SQL DDL clause about the "Key"

    Dim MyKey As ADOX.Key
    Dim MyKeyColumn As ADOX.Column
    Dim strKey As String
    Dim strColumns() As String
    Dim strKeys() As String
    Dim i As Long
    Dim iC As Long
    
    For Each MyKey In objTable.Keys
        
        Select Case MyKey.Type
        Case adKeyPrimary
            strKey = "Primary KEY "
        Case adKeyForeign
            strKey = "FOREIGN KEY "
        Case adKeyUnique
            strKey = "UNIQUE "
        End Select
        
        For Each MyKeyColumn In MyKey.Columns
            
            ReDim Preserve strColumns(iC)
            strColumns(iC) = "[" & MyKeyColumn.Name & "]"
            iC = iC + 1
        Next
        ReDim Preserve strKeys(i)
        strKeys(i) = strKey & "(" & Join(strColumns, ",") & ")"
                
        '獲取信息後，立即初始化數組
        iC = 0
        ReDim strColumns(iC)
        
        i = i + 1
    Next
    SQLKey = Join(strKeys, ",")
End Function

Function SQLField(ByVal objField As ADOX.Column)
'調用 ADOX 生成有關“字段”的 JET SQL DDL 子句
'Reference ADOX and create the JET SQL DDL clause about the "Field"

    Dim p As String
    Select Case objField.Type
        Case 11
            p = " yesno"
        Case 6
            p = " money"
        Case 7
            p = " datetime"
        Case 5
            p = " FLOAT"    'or " Double"
        Case 72
            'JET SQL DDL 語句無法創建“自動編號 GUID”字段，這里暫時用
            '[d] GUID default GenGUID() 代替部分功能，詳情請看文章
            '如何用JET SQL DDL創建自動編號GUID字段 
            'http://access911.net/?kbid;72FABE1E17DCEEF3

            If objField.Properties("Autoincrement") = True Then
                p = " autoincrement GUID"
            Else
                p = " GUID"
            End If
        Case 3
            If objField.Properties("Autoincrement") = False Then
                p = " smallint"
            Else
                p = " AUTOINCREMENT(1," & objField.Properties("Increment") & ")"
            End If
        Case 205
            p = " image"
        Case 203
            p = " memo"     'Access "HyperLink" field is also a MEMO data type.
            'ACCESS 的超級鏈接也是 MEMO 類型的
        Case 131
            p = " DECIMAL"
            p = p & "(" & objField.Precision & ")"
        Case 4
            p = " single"       'or " REAL"
        Case 2
            p = " smallint"
        Case 17
            p = " byte"
        Case 202
            p = " nvarchar"
            p = p & "(" & objField.DefinedSize & ")"
        Case 130
            '指示一個以 Null 終止的 Unicode 字符串 (DBTYPE_WSTR)。 這种數據類型用 ACCESS 設計器是無法設計出來的。
            '20100826 新增
            p = " char"
            p = p & "(" & objField.DefinedSize & ")"
        Case Else
            p = " (" & objField.Type & " Unknown,You can find it in ADOX's help. Please Check it.)"
    End Select
    
    p = "[" & objField.Name & "]" & p
    
    If IsEmpty(objField.Properties("Default")) = False Then
        p = p & " default " & objField.Properties("Default")
    End If
    
    If objField.Properties("Nullable") = False Then
        p = p & " not null"
    End If
            
    
    
    SQLField = p
End Function

'Please copy these code in VBA module and press F5 to run the follow function
'請將以下代碼 COPY 到 VBA 模塊中，然後按 F5 鍵運行以下兩段函數
Function RunTest_CreateScript()
    CreateSQLString "c:\temp.jetsql"
End Function

Function RunTest_RunScript()
    delAllTable
    RunFromText "c:\temp.jetsql"
End Function

Function delAllTable()
'在生成新表時先刪除數據庫中所有的表
'Delete all table in current mdb.
On Error Resume Next
    
    Dim t As New TableDef
    For Each t In CurrentDb.TableDefs
        If t.Attributes = 0 Then
            CurrentProject.Connection.Execute "drop table [" & t.Name & "]"
        End If
    Next
End Function

Function CreateEGTable()
    CurrentProject.Connection.Execute "create table [表e2]([ID] AUTOINCREMENT(1,1),[URL] memo,[備注] memo,[長整] smallint default 0,[大二進制] image,[日期] datetime,[數字同步复制ID] GUID,[數字字節] byte default 0,[文本50UNICODE關] nvarchar(50),[文本50UNICODE開] nvarchar(50),[文本50必填是允許空否] nvarchar(50) not null,[文本定長10] char(10),[小數精度18] DECIMAL(10) default 0,Primary KEY ([ID]))"
End Function

 

English:
Title:︰

 
How to create Jet sql DDL script with tables in current MDB database?

 

URL:︰

 
http://access911.net/?kbid;72FAB11E16DCEBF3

 

Question:︰

 
How to create Jet SQL DDL script with the tables in current MDB database?
And how to create tables in a new mdb using this Jet SQL DDL script file?
SQL Server can output a *.sql script based on the table schema. There are many "Create table" in this *.sql script. Can Access do this?

 

Answer:︰

 
MS Access does not have any built-in function for creating "Create table" script.
You can use ADOX/ADO/DAO database access component to get informations, with which you can create some JET SQL DDL sentences. With these DDL sentences you can create a "*.jetsql" script。Finally, you can create tables in a new MDB database with this script.

Notice:
Create JET SQL DDL script is NOT the best solution. Because the JET SQL DDL sentence does not support any ADOX/ADO/DAO property. JET SQL DDL sentence can not create any MS Access tables property，such as the FORMAT property.
So the most perfect solution is to create a VBA script.

Function CreateSQLString(ByVal FilePath As String) As Boolean
'This function create a "*.jetsql" script with the current mdb tables.
'This function is not the BEST, because the JET SQL DDL never support any DAO property.
    Dim MyTableName As String
    Dim MyFieldName As String
    
    Dim MyDB As New ADOX.Catalog
    Dim MyTable As ADOX.Table
    Dim MyField As ADOX.Column
    Dim pro
    Dim iC As Long
    
    Dim strField() As String
    Dim strKey As String
    Dim strSQL As String
    Dim strSQLScript As String
    
    Dim objFile, stmFile
    Dim strText As String

On Error GoTo CreateSQLScript_Err
    
    MyDB.ActiveConnection = CurrentProject.Connection
       
    For Each MyTable In MyDB.Tables
        If MyTable.Type = "TABLE" Then
            strSQL = "create table [" & MyTable.Name & "]("
            For Each MyField In MyTable.Columns
                ReDim Preserve strField(iC)
                strField(iC) = SQLField(MyField)
                iC = iC + 1
            Next
            strSQL = strSQL & Join(strField, ",")
            iC = 0
            ReDim strField(iC)
            
            'Add information of KEY
            strKey = SQLKey(MyTable)
            If Len(strKey) <> 0 Then
                strSQL = strSQL & "," & strKey
            End If
            strSQL = strSQL & ");" & vbCrLf
            strSQLScript = strSQLScript & strSQL
            
            'Debug.Print SQLIndex(MyTable)      'Never support the INDEX,to be continued...
        End If
        
    Next
    
    
    
    Set MyDB = Nothing

    'create the Jet SQL Script File
    Set objFile = CreateObject("Scripting.FileSystemObject")
    Set stmFile = objFile.CreateTextFile(FilePath, True)
    stmFile.Write strSQLScript
    stmFile.Close
    Set stmFile = Nothing
    Set objFile = Nothing

    CreateSQLScript = True

CreateSQLScript_Exit:
    Exit Function

CreateSQLScript_Err:
    MsgBox Err.Description, vbExclamation
    CreateSQLScript = False
    Resume CreateSQLScript_Exit

End Function

Function RunFromText(ByVal FilePath As String)
'This Function run the "*.jetsql" which is created by CreateSQLScript to create the tables in current mdb database.
On Error Resume Next
    Dim objFile, stmFile
    Dim strText As String
    Set objFile = CreateObject("Scripting.FileSystemObject")
    Set stmFile = objFile.OpenTextFile(FilePath, 1, False)
    strText = stmFile.ReadAll
    stmFile.Close
    Set stmFile = Nothing
    Set objFile = Nothing
    
    Dim strSQL() As String
    Dim i As Long
    strSQL = Split(strText, ";" & vbCrLf)
    For i = LBound(strSQL) To UBound(strSQL)
        CurrentProject.Connection.Execute Trim(strSQL(i))
        If Err <> 0 Then
            Debug.Print "Error SQL is:" & strSQL(i)
            Err.Clear
        End If
    Next
End Function

Function SQLKey(ByVal objTable As ADOX.Table)
'Reference ADOX and create the JET SQL DDL clause about the "Key"

    Dim MyKey As ADOX.Key
    Dim MyKeyColumn As ADOX.Column
    Dim strKey As String
    Dim strColumns() As String
    Dim strKeys() As String
    Dim i As Long
    Dim iC As Long
    
    For Each MyKey In objTable.Keys
        
        Select Case MyKey.Type
        Case adKeyPrimary
            strKey = "Primary KEY "
        Case adKeyForeign
            strKey = "FOREIGN KEY "
        Case adKeyUnique
            strKey = "UNIQUE "
        End Select
        
        For Each MyKeyColumn In MyKey.Columns
            
            ReDim Preserve strColumns(iC)
            strColumns(iC) = "[" & MyKeyColumn.Name & "]"
            iC = iC + 1
        Next
        ReDim Preserve strKeys(i)
        strKeys(i) = strKey & "(" & Join(strColumns, ",") & ")"
                
        iC = 0
        ReDim strColumns(iC)
        
        i = i + 1
    Next
    SQLKey = Join(strKeys, ",")
End Function

Function SQLField(ByVal objField As ADOX.Column)
'Reference ADOX and create the JET SQL DDL clause about the "Field"

    Dim p As String
    Select Case objField.Type
        Case 11
            p = " yesno"
        Case 6
            p = " money"
        Case 7
            p = " datetime"
        Case 5
            p = " FLOAT"    'or " Double"
        Case 72
            If objField.Properties("Autoincrement") = True Then
                p = " autoincrement GUID"
            Else
                p = " GUID"
            End If
        Case 3
            If objField.Properties("Autoincrement") = False Then
                p = " smallint"
            Else
                p = " AUTOINCREMENT(1," & objField.Properties("Increment") & ")"
            End If
        Case 205
            p = " image"
        Case 203
            p = " memo"     'Access "HyperLink" field is also a MEMO data type.
            
        Case 131
            p = " DECIMAL"
            p = p & "(" & objField.Precision & ")"
        Case 4
            p = " single"       'or " REAL"
        Case 2
            p = " smallint"
        Case 17
            p = " byte"
        Case 202
            p = " nvarchar"
            p = p & "(" & objField.DefinedSize & ")"
        Case Else
            p = " (Unknown,You can find it in ADOX's help. Please Check it.)"
    End Select
    
    p = "[" & objField.Name & "]" & p
    
    If IsEmpty(objField.Properties("Default")) = False Then
        p = p & " default " & objField.Properties("Default")
    End If
    
    If objField.Properties("Nullable") = False Then
        p = p & " not null"
    End If
            
    
    
    SQLField = p
End Function

'Please copy these code in VBA module and press F5 to run the follow function
Function RunTest_CreateScript()
    CreateSQLString "c:\temp.jetsql"
End Function

Function RunTest_RunScript()
    delAllTable
    RunFromText "c:\temp.jetsql"
End Function

Function delAllTable()
'Delete all table in current mdb.
On Error Resume Next
    
    Dim t As New TableDef
    For Each t In CurrentDb.TableDefs
        If t.Attributes = 0 Then
            CurrentProject.Connection.Execute "drop table [" & t.Name & "]"
        End If
    Next
End Function

Function CreateEGTable()
    CurrentProject.Connection.Execute "create table [table_test]([ID] AUTOINCREMENT(1,1),[URL] memo,[MenoField] memo,[LongField] smallint default 0,[BigBinaryField] image,[DatetimeField] datetime,[GUIDField] GUID,[NumberByteField] byte default 0,[Text50Field] nvarchar(50),[Text50Field2] nvarchar(50),[Text50Field3] nvarchar(50) not null,[NumberDecimalField] DECIMAL(10) default 0,Primary KEY ([ID]))"

End Function