VB6 Building Access from code

[darklynx489]

Hi All!
I've already got the code to create a full Access database from code, but the problem I'm having is that I need the property AllowZeroFill to be enabled in some sections and I'm also having problems getting the AutoIncrement to work.

Here is the code I have so far:

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

im building this for my school, and im leaving the school in less than a week, any help would be greatly apprecitated! =D

also, here is the code for the CreateAccessDatabase 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

[QVeen72]

Hi,

Try this :
After Appending the Column say MyColumn

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

Regards
Veena

[darklynx489]

Hmm.. I get an Invalid or Unqualified Reference error.
I've tried to integrate it into my code, with backlash. If you wouldn't mind, how exactly should I go about putting your code into mine?
After I build the table or inside my .columns section?

[QVeen72]

Hi,

Check these Sites :
For Allow Zero Length:
http://www.gab2001uk.com/visualbasic/tablemanipulation/index.htm

For Auto Increment :
http://support.microsoft.com/kb/275252

Regards
Veena