Ad:

Visual Basic 4 / 5 / 6 Discussion Thread
Unsolved
Views: 5865

Dec 18th, 2006

VB6 Building Access from code

Expand Post »

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:

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text)
 
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
 
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:

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text)
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
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

Last edited by darklynx489; Dec 18th, 2006 at 12:01 pm. Reason: adding support for inquisitive users

Similar Threads

Checking vulnerabilities without access to the source code? in IT Professionals' Lounge
Can we Programaticall Write code in VB6.0, forms/standard module/class code window in Visual Basic 4 / 5 / 6
VB6 and MS Access 2002 in Visual Basic 4 / 5 / 6
New key word not recoginized in VB6 connecting to Access in Visual Basic 4 / 5 / 6

darklynx489

Reputation Points: 10

Solved Threads: 0

Newbie Poster

Offline

3 posts
since Dec 2006

Permalink

Dec 18th, 2006

Re: VB6 Building Access from code

Hi,

Try this :
After Appending the Column say MyColumn

Visual Basic 4 / 5 / 6 Syntax (Toggle Plain Text)
 
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
 
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

QVeen72

Reputation Points: 84

Solved Threads: 140

Posting Shark

Offline

923 posts
since Nov 2006

Permalink

Dec 19th, 2006

Re: VB6 Building Access from code

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?

darklynx489

Reputation Points: 10

Solved Threads: 0

Newbie Poster

Offline

3 posts
since Dec 2006

Permalink

Dec 25th, 2006

Re: VB6 Building Access from code

Hi,

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

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

Regards
Veena

QVeen72

Reputation Points: 84

Solved Threads: 140

Posting Shark

Offline

923 posts
since Nov 2006

This thread is more than three months old

No one has posted to this discussion for at least three months. Please let old threads die and do not reply to them unless you feel you have something new and valuable to contribute that absolutely must be added to make the discussion complete. Otherwise, please start a new thread in this forum instead.

Previous Thread in Visual Basic 4 / 5 / 6 Forum Timeline: Listview

Next Thread in Visual Basic 4 / 5 / 6 Forum Timeline: Help on making and using Database in VB

DaniWeb Message

Cancel Changes

User Name
Password