Option Explicit
Public Function AutoCreateAccess(ByVal sDatabaseToCreate As String) As Boolean
CreateAccessDatabase (sDatabaseToCreate) 'Creates the database
 
Dim catDB As ADOX.Catalog
Dim tblNew As ADOX.Table
Set catDB = New ADOX.Catalog
 
' Open the catalog
catDB.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sDatabaseToCreate
'-------------------------------------------------
' Create new Table and add the columns
Set tblNew = New ADOX.Table
tblNew.Name = "bellschedule"
With tblNew
    With .Columns
        .Append "period", adVarWChar, 50
        .Append "bellday", adVarWChar, 50
        .Append "timefrom", adDate, 8
        .Append "timeto", adDate, 8
    End With
 
    Dim adColNullable 
        adColNullable = 2
        With .Columns("period")
            .Attributes = adColNullable 'Unchecks the REQUIRED box
        End With
        With .Columns("bellday")
            .Attributes = adColNullable
        End With
        With .Columns("timefrom")
            .Attributes = adColNullable
        End With
        With .Columns("timeto")
            .Attributes = adColNullable
        End With
End With
catDB.Tables.Append tblNew
'-------------------------------------------------'
'-------------------------------------------------
' Create new Table and add the columns
Set tblNew = New ADOX.Table
tblNew.Name = "schoolinfo"
With tblNew
    With .Columns
        .Append "schoolname", adVarWChar, 50
        .Append "district", adVarWChar, 50
    End With
 
        With .Columns("schoolname")
            .Attributes = adColNullable
        End With
        With .Columns("district")
            .Attributes = adColNullable
        End With
End With
catDB.Tables.Append tblNew
'-------------------------------------------------
' Create new Table and add the columns
Set tblNew = New ADOX.Table
tblNew.Name = "students"
With tblNew
    With .Columns
        .Append "firstname", adVarWChar, 50
        .Append "lastname", adVarWChar, 50
        .Append "DOB", adDate, 8
        .Append "picture", adBinary
        .Append "id", adVarWChar, 25
        .Append "gender", adVarWChar, 2
        .Append "middlename", adVarWChar, 50
 
    End With
 
        With .Columns("firstname")
            .Attributes = adColNullable
        End With
        With .Columns("lastname")
            .Attributes = adColNullable
        End With
        With .Columns("DOB")
            .Attributes = adColNullable
        End With
        With .Columns("picture")
            .Attributes = adColNullable
        End With
        With .Columns("id")
            .Attributes = adColNullable
        End With
        With .Columns("gender")
            .Attributes = adColNullable
        End With
        With .Columns("middlename")
            .Attributes = adColNullable
        End With
End With
catDB.Tables.Append tblNew
'-------------------------------------------------
' Create new Table and add the columns
Set tblNew = New ADOX.Table
tblNew.Name = "tardies"
With tblNew
    .ParentCatalog = catDB ' need this to recognize special properties
    With .Columns
        .Append "id", adVarWChar, 25
        .Append "tdate", adDate, 8
        .Append "ttime", adDate, 8
        .Append "period", adVarWChar, 25
        .Append "tardyid", adLongVarWChar, 4
    End With
 
        With .Columns("id")
            .Attributes = adColNullable
        End With
        With .Columns("tdate")
            .Attributes = adColNullable
        End With
        With .Columns("ttime")
            .Attributes = adColNullable
        End With
        With .Columns("period")
            .Attributes = adColNullable
        End With
        With .Columns("tardyid")
            .Properties("AutoIncrement") = True  'HERE IS THE PROBELM!!
            .Attributes = adColNullable
        End With
End With
catDB.Tables.Append tblNew
'------------------------------------------'
Set tblNew = Nothing
Set catDB = Nothing
AutoCreateAccess = True
End Function

Public Function CreateAccessDatabase(ByVal sDatabaseToCreate As String) As Boolean
Dim catNewDB As ADOX.Catalog
Set catNewDB = New ADOX.Catalog
catNewDB.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
    "Data Source=" & sDatabaseToCreate & _
    ";Jet OLEDB:Engine Type=4;"
    ' Engine Type=5 = Access 2000 Database
    ' Engine Type=4 = Access 97 Database
 
Set catNewDB = Nothing
CreateAccessDatabase = True
End Function

 
Dim cat As New ADOX.Catalog
 
Set cat.ActiveConnection = CurrentProject.Connection
 
With !MyColumn
    .Append "MyColumn", adWChar, 50
    Set .ParentCatalog = cat
    .Properties("Jet OLEDB:Allow Zero Length") = True
    .Properties("Nullable") = True
End With
 
 
With .Columns   
    .Append "Auto_ID", adInteger   
    With !Auto_ID      
        Set .ParentCatalog = cat          
        .Properties("Autoincrement") = True          
        .Properties("seed") = CLng(20)          
        .Properties("increment") = CLng(20)   
    End With
End With