VBA code to script a table definition to Jet SQL

The vba code below can be used to script an access table into JET SQL. The function can handle multiple tables separated by commas. To use it, open your ms access database create a new module and paste the code of the subroutine. You can then call it from the immediate window like this:

Call TableCreateDDL("Table1", "Table2")

Here is the sub:

Public Sub TableCreateDDL(ParamArray tbls())

    Dim fldDef As DAO.field, rel As DAO.Relation
    Dim ifldIndex As Integer
    Dim fldName As String, fldDataInfo As String
    Dim tblDDL As String
    Dim TableDef As DAO.TableDef
    Dim idx As DAO.index
    Dim pkname As String
    Dim pkfieldName As String
    Dim fks As String
    Dim d As Database
    Dim tbl As String
    Dim ct As Integer
    
    Set d = CodeDb
    
    For ct = 0 To UBound(tbls)
        tbl = tbls(ct)
        fks = ""
        Set TableDef = d.TableDefs(tbl)
        
        For Each idx In TableDef.Indexes
            If idx.Primary Then
                pkname = idx.Name
                pkfieldName = idx.Fields(0).Name
                Exit For
            End If
            If idx.Unique Then
                If fks <> "" Then
                    fks = fks & ","
                End If
                fks = fks & "CONSTRAINT " & idx.Name & " UNIQUE ("
                For ifldIndex = 0 To idx.Fields.Count - 1
                    Set fldDef = idx.Fields(ifldIndex)
                    If ifldIndex > 0 Then
                        fks = fks & ","
                    End If
                    fks = fks & fldDef.Name
                Next
                fks = fks & ")"
            End If
            
        Next
        For Each rel In d.Relations
            If LCase$(rel.ForeignTable) = LCase$(tbl) Then
                'Debug.Print rel.ForeignTable
                If fks <> "" Then
                    fks = fks & "," & vbCrLf
                End If
                fks = fks & vbTab & "CONSTRAINT [" & rel.Name & "] FOREIGN KEY (" & rel.Fields(0).Name & _
                    ") REFERENCES " & _
                    rel.Table & "(" & rel.Fields(0).ForeignName
                fks = fks & ")"
                If DAO.dbRelationUpdateCascade = (rel.Attributes And DAO.dbRelationUpdateCascade) Then
                    fks = fks & vbCrLf & vbTab & vbTab & " ON UPDATE CASCADE "
                End If
                
                If DAO.dbRelationDeleteCascade = (rel.Attributes And DAO.dbRelationDeleteCascade) Then
                    fks = fks & vbCrLf & vbTab & vbTab & " ON DELETE CASCADE "
                End If
            End If
        Next
        
        tblDDL = tblDDL & "create table [" & tbl & "] (" & vbCrLf
        
        For ifldIndex = 0 To TableDef.Fields.Count - 1
            'For Each fldDef In TableDef.Fields
            Set fldDef = TableDef.Fields(ifldIndex)
            
            fldName = fldDef.Name
            fldName = "[" & fldName & "] "
            
            If dbAutoIncrField = (fldDef.Attributes And dbAutoIncrField) Then
                fldDataInfo = " AUTOINCREMENT "
            Else
            
                Select Case fldDef.type
                    Case dbBoolean
                        fldDataInfo = "BOOLEAN"
                    Case dbByte
                        fldDataInfo = "BYTE"
                    Case dbInteger
                        fldDataInfo = "INTEGER"
                    Case dbLong
                        fldDataInfo = "LONG"
                    Case dbCurrency
                        fldDataInfo = "CURRENCY"
                    Case dbSingle
                        fldDataInfo = "SINGLE"
                    Case dbDouble
                        fldDataInfo = "number"
                    Case dbDate
                        fldDataInfo = "date"
                    Case dbText
                        fldDataInfo = "varchar(" & format$(fldDef.Size) & ")"
                    Case dbLongBinary
                        fldDataInfo = "****"
                    Case dbMemo
                        fldDataInfo = "MEMO"
                    Case dbGUID
                        fldDataInfo = "nvarchar2(16)"
                End Select
                If fldDef.required Then
                    tblDDL = tblDDL & " not null"
                End If
            
            End If
            
            If ifldIndex > 0 Then
                tblDDL = tblDDL & ", " & vbCrLf
            End If
            tblDDL = tblDDL & vbTab & fldName & " " & fldDataInfo
        
        Next
        If (pkname <> "") Then
            tblDDL = tblDDL & "," & vbCrLf & vbTab & "CONSTRAINT  " & pkname & " PRIMARY KEY (" & pkfieldName & ")"
        End If
        If fks <> "" Then
            tblDDL = tblDDL & "," & vbCrLf & vbTab & fks
        End If
        
        tblDDL = tblDDL & ")" & vbCrLf
        
    Next
    
    Debug.Print tblDDL

    Set d = Nothing
    Set TableDef = Nothing
    Set fldDef = Nothing
    Set idx = Nothing
    Set rel = Nothing
    
End Sub

As an example, in one of our access database projects we had to script table called "ssirate" Here is the output of the above sub call:

create table [ssirate] (
    [ssirid]   AUTOINCREMENT  not null, 
    [socinsCategoryid]  LONG not null, 
    [payrollItemId]  LONG not null, 
    [effectiveDate]  date not null, 
    [rate]  SINGLE, 
    [createdate]  date, 
    [updatedate]  date, 
    [createuser]  LONG, 
    [updateuser]  LONG,
    CONSTRAINT  PK_ssirate PRIMARY KEY (ssirid))