How to create database (.mdb) file in vb6 code

darklynx489 · December 20th, 2006, 08:56 AM

Alright, this is a bit late, but I'm having problems setting the AutoIncrement property of the fields and also, is there a way to set the AllowZeroLength?
here is my code (i used Imar's code, thank you so much Imar!)

Code:

Option Explicit
Public Function AutoCreateAccess(ByVal sDatabaseToCreate As String) As Boolean
CreateAccessDatabase (sDatabaseToCreate)

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
        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
    Set .ParentCatalog = catDB
    With .Columns
        .Append "id", adVarWChar, 25
        .Append "tdate", adDate, 8
        .Append "ttime", adDate, 8
        .Append "period", adVarWChar, 25
        .Append "tardyid", adInteger, 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 'MULTIPLE STEP ERROR HERE
            .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

the full error for the multple step herror is "Run-time error '-2147217887(80040e21)':
Multiple-step OLE DB operation generated errors. Check each OLE DB status value, if available. No work was done.

and if I comment out my .properties("Autoincrement")= true, then it works fine.

PLEEAASE i beg of you!!
thank you!!

Imar · December 20th, 2006, 09:14 AM

Hi there,

Why are you trying to set AutoIncrement and AllowZeroLength at the same time? AFAIK, you can't mix the two. With an AutoIncrement column, each record automatically gets a new, increased value...

Imar
---------------------------------------
Imar Spaanjaars
Everyone is unique, except for me.

deepmadan · June 30th, 2009, 03:19 AM

hello

i used the code above to create access database at runtime in vb6
the database file was created but it is showing error while adding the table to the databse.

my code is :

Code:

Public Sub CreateAccessDatabase(sDatabaseToCreate)
    Dim catDB As ADOX.Catalog
    Dim tblNew As ADOX.Table
    Dim fso As Object
    
    Set fso = CreateObject("scripting.FileSystemObject")
    If Not fso.FileExists(sDatabaseToCreate) Then
       Set catDB = New ADOX.Catalog
       catDB.create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sDatabaseToCreate & _
        ";Jet OLEDB:Engine Type=5;"
         Set catDB = Nothing
     End If
  createtable (sDatabaseToCreate)
End Sub

Public Sub CreateAccessTable(sDatabaseToCreate)
     
    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
    Set tblNew = New ADOX.Table
    tblNew.Name = "voicedatalog"
Dim col  As ADOX.Column
    Set col = New ADOX.Column
    
    With col
        .ParentCatalog = catDB
        .Type = adVarWChar  '= adInteger ' adText does not exist
        .Name = "File_Name"
       
        .Properties("Autoincrement") = False
        '.Properties("Description") = "I am the Description " & _
        '    "for the column"
    End With
    tblNew.Columns.Append col
With tblNew
         ' Create fields and append them to the
         ' Columns collection of the new Table object.
         With .Columns
             .Append "Session_type", adChar, 1
             .Append "Channel_no", adInteger
             .Append "Date_value", adDate
             .Append "Start_time", adDate
             .Append "Phone_no", adVarWChar, 15
             .Append "Remarks", adLongVarWChar, 250
         End With
catDB.Tables.Append tblNew   ' >>>>> error : type is invalid
     Set col = Nothing
     Set tblNew = Nothing
     Set catDB = Nothing
End Sub

error coming is type is invalid while appending table to the database

please help me....

thanks in advance

ahmedattia2010 · August 7th, 2009, 11:39 AM

hi imar i used your code to make mdb file but i want to fill it from
text boxes in my app and also write text in fields i choose
please replay if u can help