Ex4: VBA - Create a table using ADOX

Create a table with various field types using ADOX in VBA

Function CreateTableAdox()
    'Purpose:   Create a table with various field types, using ADOX.
    Dim cat As New ADOX.Catalog
    Dim tbl As ADOX.Table
    
    Set cat.ActiveConnection = CurrentProject.Connection
    'Initialize the Contractor table.
    Set tbl = New ADOX.Table
    tbl.Name = "tblAdoxContractor"
    
    'Append the columns.
    With tbl.Columns
        .Append "ContractorID", adInteger   'Number (Long Integer)
        .Append "Surname", adVarWChar, 30   'Text (30 max)
        .Append "FirstName", adVarWChar, 20 'Text (20 max)
        .Append "Inactive", adBoolean       'Yes/No
        .Append "HourlyFee", adCurrency     'Currency
        .Append "PenaltyRate", adDouble     'Number (Double)
        .Append "BirthDate", adDate         'Date/Time
        .Append "Notes", adLongVarWChar     'Memo
        .Append "Web", adLongVarWChar       'Memo (for hyperlink)
        
        'Set the field properties.
        'AutoNumber
        With !ContractorID
            Set .ParentCatalog = cat
            
            .Properties("Autoincrement") = True     'AutoNumber.
            .Properties("Description") = "Automatically " & _
                "generated unique identifier for this record."
        End With
        
        'Required field.
        With !Surname
            Set .ParentCatalog = cat
            .Properties("Nullable") = False         'Required.
            .Properties("Jet OLEDB:Allow Zero Length") = False
        End With
        
        'Set a validation rule.
        With !BirthDate
            Set .ParentCatalog = cat
            .Properties("Jet OLEDB:Column Validation Rule") = _
                "Is Null Or <=Date()"
            .Properties("Jet OLEDB:Column Validation Text") = _
                "Birth date cannot be future."
        End With
        
        'Hyperlink field.
        With !Web
            Set .ParentCatalog = cat
            .Properties("Jet OLEDB:Hyperlink") = True 'Hyperlink.
        End With
    End With
    
    'Save the new table by appending to catalog.
    cat.Tables.Append tbl
    Debug.Print "tblAdoxContractor created."
    Set tbl = Nothing
    
    'Initialize the Booking table
    Set tbl = New ADOX.Table
    tbl.Name = "tblAdoxBooking"
    
    'Append the columns.
    With tbl.Columns
        .Append "BookingID", adInteger
        .Append "BookingDate", adDate
        .Append "ContractorID", adInteger
        .Append "BookingFee", adCurrency
        .Append "BookingNote", adWChar, 255
        
        'Set the field properties.
        With !BookingID                             'AutoNumber.
            .ParentCatalog = cat
            .Properties("Autoincrement") = True
        End With
        With !BookingNote                           'Required.
            .ParentCatalog = cat
            .Properties("Nullable") = False
            .Properties("Jet OLEDB:Allow Zero Length") = False
        End With
    End With
    
    'Save the new table by appending to catalog.
    cat.Tables.Append tbl
    Debug.Print "tblAdoxBooking created."
    
    'Clean up
    Set tbl = Nothing
    Set cat = Nothing
End Function