如何用JET SQL DDL创建自动编号GUID字段

问题:

本文起因于我的两篇文章

 

    数据定义查询不会怎么办?
    http://access911.net/index.asp?u1=a&u2=71FAB01E15DC

    如何根据当前MDB中的表生成对应的JET SQL DDL “CREATE TABLE”语句/脚本?
    http://access911.net/index.asp?u1=a&u2=72FAB11E16DCEBF3

和网友的一封询问 EMAIL,问“filed1 AUTOINCREMENT guid 但为什么实际增加的仍然是长整形呢?”

 

 

回答:

我做了以下测试,示例下载:
http://access911.net/down/eg/JetSQLDDL_Create_Table_AUTOINCREMENT_guid.rar (30KB)

 

我的个人测试结论为 AUTOINCREMENT guid 可以正常运行,但是结果仍然是创建“自动编号 长整 递增”类型的字段,而不能创建“自动编号 GUID”字段。而且我查询了大量 INTERNET 以及 SUPPORT 上的英文资料,在
Description of the new features that are included in Microsoft Jet 4.0
http://support.microsoft.com/kb/275561/en-us
一文中找到
Auto-Increment fields can only use the LongInteger data type for defining fields whose values are automatically generated by the Microsoft Jet Database Engine. The following shows an example of how to define an auto-incrementing field:  的官方描述。因此 “自动编号 GUID”字段只能用 ADOX 或者 DAO 来创建而无法用 JET SQL DDL 语句来创建。

本次测试还证实:
创建“自动编号 长整 随机”字段的代码为

create table [datatype]([c] Autoincrement(1,1) default GenUniqueID())


创建“GUID”字段并且有默认值的代码为
create table [datatype]([d] GUID default GenGUID())


以下为全部测试代码:


'★     注意,本测试是由文章
'       《数据定义查询不会怎么办?》
'       http://access911.net/?kbid;71FAB01E15DC
'       中 “dd autoincrement guid ”的描述引发的,当时写上述文章的环境可能是 OFFICE 2000 ,现在
'       我没有此环境无法测试,暂时先把本次测试的结果记录下来
'       本次测试还关联到一篇文章代码的正确性,请大家认真参考一下
'       《如何根据当前MDB中的表生成对应的JET SQL DDL “CREATE TABLE”语句/脚本?》
'       http://access911.net/?kbid;72FAB11E16DCEBF3
'       上述文章中有关 DDL 建立 自动编号 GUID 部分的代码需要更改
'       为便于区分,打 ★ 的代码是与本测试直接相关的代码,其他为辅助代码

 


'★ -- test #1 start
'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
'★ -- test #1 end

'★     以下是 Debug.Print 出来的结果,大家可以明显看出不同,我用 ☆ 将不同点标出
'       表1:aa 字段,自动编号 长整 递增;
'       表2:bb 字段,自动编号 长整 随机;
'       表3:cc 字段,自动编号 GUID
'
'        ----------    aa 自动编号 长整 递增;            ----------
'☆      Autoincrement True
'☆      Default
'        Description
'        Nullable True
'        Fixed Length  True
'        Seed 1
'        Increment 1
'        Jet OLEDB:Column Validation Text
'        Jet OLEDB:Column Validation Rule
'        Jet OLEDB:IISAM Not Last Column           False
'☆      Jet OLEDB: AutoGenerate False
'        Jet OLEDB:One BLOB per Page False
'        Jet OLEDB:Compressed UNICODE Strings      False
'        Jet OLEDB:Allow Zero Length False
'        Jet OLEDB: Hyperlink False
'        ----------    bb 自动编号 长整 随机;            ----------
'☆      Autoincrement True
'☆      Default GenUniqueID()
'        Description
'        Nullable True
'        Fixed Length  True
'        Seed 1
'        Increment 1
'        Jet OLEDB:Column Validation Text
'        Jet OLEDB:Column Validation Rule
'        Jet OLEDB:IISAM Not Last Column           False
'☆      Jet OLEDB: AutoGenerate False
'        Jet OLEDB:One BLOB per Page False
'        Jet OLEDB:Compressed UNICODE Strings      False
'        Jet OLEDB:Allow Zero Length False
'        Jet OLEDB: Hyperlink False
'        ----------    cc 自动编号 GUID            ----------
'☆      Autoincrement False
'☆      Default GenGUID()
'        Description
'        Nullable True
'        Fixed Length  True
'        Seed 1
'        Increment 1
'        Jet OLEDB:Column Validation Text
'        Jet OLEDB:Column Validation Rule
'        Jet OLEDB:IISAM Not Last Column           False
'☆      Jet OLEDB: AutoGenerate True
'        Jet OLEDB:One BLOB per Page False
'        Jet OLEDB:Compressed UNICODE Strings      False
'        Jet OLEDB:Allow Zero Length False
'        Jet OLEDB: Hyperlink False


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
            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 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
            
    '★ -- test #2 start
    '这里让我们来监测一下自动编号字段和GUID字段的不同吧
    '注意,在做这个测试时必须手动创建三个表,每个表都只包含一个自动编号字段,
    '表1:aa 字段,自动编号 长整 递增;
    '表2:bb 字段,自动编号 长整 随机;
    '表3:cc 字段,自动编号 GUID

    Dim bbb
    Debug.Print String(10, "-"), objField.Name, String(10, "-")
    For Each bbb In objField.Properties
        Debug.Print bbb.Name, bbb.Value
    Next
    '★ -- test #2 end
    
    SQLField = p
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,[小数精度18] DECIMAL(10) default 0,Primary KEY ([ID]))"
End Function


你可能感兴趣的:(sql)