Access VBA 之 iT管理實做Day25: 由Access的Table結構產生DDL文字

2019 iT 邦幫忙鐵人賽

DAY 25

自我挑戰組

Access VBA 之 iT管理實做系列第 25 篇

2019鐵人賽

Andy Chiu

2018-11-09 04:06:52

2341 瀏覽

資料庫中的資料表，可以透過DDL語言(Data Definition Language,資料定義語言)來產生，但是否有辦法由現有的資料表，來產生DDL語言呢？可以的，只要把相關屬性帶出來，就可以產生，我使用了Allen Browne撰寫的顯示資料表欄位內容的程式來進行改寫，用來產生DDL語句。

以下程式為Allen Browne撰寫的查詢資料表程式：

'Microsoft Access: VBA Programming Code
''Provided by Allen Browne.  Last updated: April 2010.

''TableInfo() function

''This function displays in the Immediate Window (Ctrl+G) the structure of any table in the current database.
'For Access 2000 or 2002, make sure you have a DAO reference.
'The Description property does not exist for fields that have no description, so a separate function handles that error.
'
'http://allenbrowne.com/func-06.html
'
Sub TableInfo_test()
    Call TableInfo("Config")

End Sub

Function TableInfo(strTableName As String)
On Error GoTo TableInfoErr
   ' Purpose:   Display the field names, types, sizes and descriptions for a table.
   ' Argument:  Name of a table in the current database.
   Dim db As DAO.Database
   Dim tdf As DAO.TableDef
   Dim fld As DAO.Field
   
   Set db = CurrentDb()
   Set tdf = db.TableDefs(strTableName)
   Debug.Print "FIELD NAME", "FIELD TYPE", "SIZE", "DESCRIPTION"
   Debug.Print "==========", "==========", "====", "==========="

   For Each fld In tdf.fields
      Debug.Print fld.Name,
      Debug.Print FieldTypeName(fld),
      Debug.Print fld.Size,
      Debug.Print GetDescrip(fld)
   Next
   Debug.Print "==========", "==========", "====", "==========="

TableInfoExit:
   Set db = Nothing
   Exit Function

TableInfoErr:
   Select Case Err
   Case 3265&  'Table name invalid
      MsgBox strTableName & " table doesn't exist"
   Case Else
      Debug.Print "TableInfo() Error " & Err & ": " & Error
   End Select
   Resume TableInfoExit
End Function


Function GetDescrip(obj As Object) As String
    On Error Resume Next
    GetDescrip = obj.Properties("Description")
End Function


Function FieldTypeName(fld As DAO.Field) As String
    'Purpose: Converts the numeric results of DAO Field.Type to text.
    Dim strReturn As String    'Name to return

    Select Case CLng(fld.TYPE) 'fld.Type is Integer, but constants are Long.
        Case dbBoolean: strReturn = "Yes/No"            ' 1
        Case dbByte: strReturn = "Byte"                 ' 2
        Case dbInteger: strReturn = "Integer"           ' 3
        Case dbLong                                     ' 4
            If (fld.Attributes And dbAutoIncrField) = 0& Then
                strReturn = "Long Integer"
            Else
                strReturn = "AutoNumber"
            End If
        Case dbCurrency: strReturn = "Currency"         ' 5
        Case dbSingle: strReturn = "Single"             ' 6
        Case dbDouble: strReturn = "Double"             ' 7
        Case dbDate: strReturn = "Date/Time"            ' 8
        Case dbBinary: strReturn = "Binary"             ' 9 (no interface)
        Case dbText                                     '10
            If (fld.Attributes And dbFixedField) = 0& Then
                strReturn = "Text"
            Else
                strReturn = "Text (fixed width)"        '(no interface)
            End If
        Case dbLongBinary: strReturn = "OLE Object"     '11
        Case dbMemo                                     '12
            If (fld.Attributes And dbHyperlinkField) = 0& Then
                strReturn = "Memo"
            Else
                strReturn = "Hyperlink"
            End If
        Case dbGUID: strReturn = "GUID"                 '15

        'Attached tables only: cannot create these in JET.
        Case dbBigInt: strReturn = "Big Integer"        '16
        Case dbVarBinary: strReturn = "VarBinary"       '17
        Case dbChar: strReturn = "Char"                 '18
        Case dbNumeric: strReturn = "Numeric"           '19
        Case dbDecimal: strReturn = "Decimal"           '20
        Case dbFloat: strReturn = "Float"               '21
        Case dbTime: strReturn = "Time"                 '22
        Case dbTimeStamp: strReturn = "Time Stamp"      '23

        'Constants for complex types don't work prior to Access 2007 and later.
        Case 101&: strReturn = "Attachment"         'dbAttachment
        Case 102&: strReturn = "Complex Byte"       'dbComplexByte
        Case 103&: strReturn = "Complex Integer"    'dbComplexInteger
        Case 104&: strReturn = "Complex Long"       'dbComplexLong
        Case 105&: strReturn = "Complex Single"     'dbComplexSingle
        Case 106&: strReturn = "Complex Double"     'dbComplexDouble
        Case 107&: strReturn = "Complex GUID"       'dbComplexGUID
        Case 108&: strReturn = "Complex Decimal"    'dbComplexDecimal
        Case 109&: strReturn = "Complex Text"       'dbComplexText
        Case Else: strReturn = "Field type " & fld.TYPE & " unknown"
    End Select

    FieldTypeName = strReturn
End Function

我依照他的程式，再建立另一個產生DDL語法的產生資料表程式：

Function CreateTableByTable(strSrcTableName As String, strDesTableName As String) As String
On Error GoTo TableInfoErr
   ' Purpose:   Display the field names, types, sizes and descriptions for a table.
   ' Argument:  Name of a table in the current database.
   Dim db As DAO.Database
   Dim tdf As DAO.TableDef
   Dim fld As DAO.Field
   
   Set db = CurrentDb()
   Set tdf = db.TableDefs(strSrcTableName)
   strData_Start = "CREATE TABLE " & strDesTableName & " (" & vbCrLf
    
    strData_Content = ""
   For Each fld In tdf.Fields
        If strData_Content <> "" Then strData_Content = strData_Content & "," & vbCrLf
        strData_Content = strData_Content & "[" & fld.Name & "] " & FieldDDL(fld)
   Next
   strData_End = ")" & vbCrLf

    strData = strData_Start & strData_Content & strData_End
    Debug.Print strData
    CreateTableByTable = strData

TableInfoExit:
   Set db = Nothing
   Exit Function

TableInfoErr:
   Select Case err
   Case 3265&  'Table name invalid
      MsgBox strTableName & " table doesn't exist"
   Case Else
      Debug.Print "TableInfo() Error " & err & ": " & Error
   End Select
   Resume TableInfoExit
End Function

Function FieldDDL(fld As DAO.Field) As String
    'Purpose: Converts the numeric results of DAO Field.Type to text.
    Dim strReturn As String    'Name to return

'    Debug.Print fld.Name
'    Debug.Print fld.size
'    Debug.Print fld.TYPE
'    Debug.Print fld.Required
'    Debug.Print fld.AllowZeroLength
'    Debug.Print fld.DefaultValue

    Select Case CLng(fld.TYPE) 'fld.Type is Integer, but constants are Long.
        Case dbBoolean: strReturn = "YESNO"            ' 1
        Case dbByte: strReturn = "BYTE"                 ' 2
        Case dbInteger: strReturn = "SHORT"           ' 3
        Case dbLong                                     ' 4
            If (fld.Attributes And dbAutoIncrField) = 0& Then
                strReturn = "LONG"
            Else
                strReturn = "COUNTER"
            End If
        Case dbCurrency: strReturn = "CURRENCY"         ' 5
        Case dbSingle: strReturn = "SINGLE"             ' 6
        Case dbDouble: strReturn = "DOUBLE"             ' 7
        Case dbDate: strReturn = "DATETIME"            ' 8
        Case dbBinary: strReturn = "BINARY (" & fld.Size & ")"             ' 9 (no interface)
        Case dbText                                     '10
            If (fld.Attributes And dbFixedField) = 0& Then
                strReturn = "TEXT (" & fld.Size & ")"
            Else
                strReturn = "CHAR (" & fld.Size & ")"        '(no interface)
            End If
        Case dbLongBinary: strReturn = "LONGBINARY"     '11
        Case dbMemo                                     '12
            If (fld.Attributes And dbHyperlinkField) = 0& Then
                strReturn = "MEMO"
            Else
                strReturn = "MEMO"
            End If
        Case dbGUID: strReturn = "GUID"                 '15

        'Attached tables only: cannot create these in JET.
        Case dbBigInt: strReturn = "Big Integer"        '16
        Case dbVarBinary: strReturn = "VarBinary"       '17
        Case dbChar: strReturn = "Char"                 '18
        Case dbNumeric: strReturn = "Numeric"           '19
        Case dbDecimal: strReturn = "DECIMAL (precision, scale) "           '20
        Case dbFloat: strReturn = "Float"               '21
        Case dbTime: strReturn = "Time"                 '22
        Case dbTimeStamp: strReturn = "Time Stamp"      '23

        'Constants for complex types don't work prior to Access 2007 and later.
        Case 101&: strReturn = "Attachment"         'dbAttachment
        Case 102&: strReturn = "Complex Byte"       'dbComplexByte
        Case 103&: strReturn = "Complex Integer"    'dbComplexInteger
        Case 104&: strReturn = "Complex Long"       'dbComplexLong
        Case 105&: strReturn = "Complex Single"     'dbComplexSingle
        Case 106&: strReturn = "Complex Double"     'dbComplexDouble
        Case 107&: strReturn = "Complex GUID"       'dbComplexGUID
        Case 108&: strReturn = "Complex Decimal"    'dbComplexDecimal
        Case 109&: strReturn = "Complex Text"       'dbComplexText
        Case Else: strReturn = "Field type " & fld.TYPE & " unknown"
    End Select

    FieldDDL = strReturn
End Function

測試一下，把Config資料表的欄位資料產生DDL語言，用來產生Config2資料表：
Sub CreateTableByTable_TEST()
    Call CreateTableByTable("Config", "Config2")
    
End Sub

得到的結果：

CREATE TABLE Config2 (
[Name] TEXT (255),
[Value] TEXT (255),
[Note] MEMO)

不過目前只有產生資料表的部份有做好，其餘Key、Index、關聯等，就都還沒有去研究了，因為DDL語言還是有其限制，因為要各資料庫通用，所以有些Access自定義的屬性，就無法支援，例如欄位描述，相關討論可參考以下：
https://stackoverflow.com/questions/3521188/ms-access-setting-table-column-caption-or-description-in-ddl

資料定義語言：
https://zh.wikipedia.org/wiki/資料定義語言

Field type reference - names and values for DDL, DAO, and ADOX:
http://allenbrowne.com/ser-49.html