Creating Autonumbered Primarykey

[baha17]

Hi Everyone,


I created the access table by using VBA code. Actually I found the code on net and altered that a bit. My problem is I want the primarykey is to be autonumbered. How can I define that? Below is my code
Thanks for helping me
Baha

Option Explicit
Const TARGET_DB = "DB_Allocation.mdb"
Sub CreateDB_And_Table()
  Sheets("Copy").Select
    Dim cat As ADOX.Catalog
    Dim tbl, tbl2 As ADOX.Table
    Dim sDB_Path As String
    
    sDB_Path = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB
    
    On Error Resume Next
    Kill sDB_Path
    On Error GoTo 0
   
    Set cat = New ADOX.Catalog
    cat.Create _
        "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & sDB_Path & ";"
    
    Set tbl2 = New ADOX.Table
    tbl2.Name = "tblStaffReq"
    tbl2.Columns.Append "ReqID", adInteger, 3
    tbl2.Columns.Append "PitId", adDouble
    tbl2.Columns.Append "ReqDlr", adDouble
    tbl2.Columns.Append "RmkDlr", adVarWChar, 25
    tbl2.Columns.Append "DlrTime", adVarWChar, 8
    tbl2.Columns.Append "ReqSup", adDouble
    tbl2.Columns.Append "RmkSup", adVarWChar, 25
    tbl2.Columns.Append "SupTime", adVarWChar, 8
    tbl2.Columns.Append "ReqPM", adVarWChar, 8
    cat.Tables.Append tbl2 'HERE I GOT THE ERROR
    Set cat = Nothing
    
   ADOCreatePrimaryKey
   
End Sub

Sub ADOCreatePrimaryKey()
    Dim cat As New ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim pk As New ADOX.Key
    Dim MyConn
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
    cat.ActiveConnection = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
       "Data Source=" & MyConn & ";"
    
    Set tbl = cat.Tables("tblStaffReq")
    pk.Name = "PrimaryKey"
    pk.Type = adKeyPrimary
    pk.Columns.Append "ReqID"
    tbl.Keys.Append pk
End Sub

 

[SydneyGeek]

To create an Autonumber I think you need to use the Counter datatype.
Integer won't increment, and its ceiling is 32K records; Autonumber is a special type of Long Integer.

Denis

 

[baha17]

Hi Denis,
Thank you very much for your reply. So you mean i need to change below part?
I could not understand very well

tbl2.Columns.Append "ReqID", adInteger, 3

Thank you

 

[SydneyGeek]

Sorry, my mistake. You use Counter for SQL.
However, to make the field an AutoNumber you need to define some additional properties. See ... Use ADOX to Manipulate AutoNumber Fields
Denis

 

[baha17]

Thank you Denis seems like this is what I am looking for.
Cheers
Baha

 

[baha17]

Hi Denis,

I read the whole article couple of times. But I still could not get it done to set up autonumbered primary key. My code is in excel 2007 vba. I changed my code to below:

Option Explicit
Const TARGET_DB = "DB_Allocation.mdb"
Sub CreateDB_And_Table()
Sheets("Copy").Select
Dim cat As ADOX.Catalog
Dim tbl, tbl2 As ADOX.Table
Dim sDB_Path As String

sDB_Path = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB

On Error Resume Next
Kill sDB_Path
On Error GoTo 0

Set cat = New ADOX.Catalog
cat.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sDB_Path & ";"

Set tbl2 = New ADOX.Table
tbl2.Name = "tblStaffReq"
'tbl2.Columns.Append "ReqId", adInteger
With col
.Name = "ReqId"
.Type = adInteger
Set .ParentCatalog = cat
.Properties("AutoIncrement") = True
.Properties("Increment") = CLng(1)
End With
tbl2.Columns.Append "PitId", adInteger
tbl2.Columns.Append "ReqDlr", adDouble
tbl2.Columns.Append "ReqDSkl", adVarWChar, 8
tbl2.Columns.Append "RmkDlr", adVarWChar, 25
tbl2.Columns.Append "DlrTime", adVarWChar, 8
tbl2.Columns.Append "ReqSup", adDouble
tbl2.Columns.Append "ReqSSkl", adVarWChar, 8
tbl2.Columns.Append "RmkSup", adVarWChar, 25
tbl2.Columns.Append "SupTime", adVarWChar, 8
tbl2.Columns.Append "ReqPM", adVarWChar, 8
cat.Tables.Append tbl2 'HERE I GOT THE ERROR
Set cat = Nothing

Can you help me please
Baha

 

[SydneyGeek]

Change this bit...

'tbl2.Columns.Append "ReqId", adInteger
    With col
        .Name = "ReqId"
        .Type = adInteger
    Set .ParentCatalog = cat
        .Properties("AutoIncrement") = True
        .Properties("Increment") = CLng(1)
    End With

to this

tbl2.Columns.Append "ReqId", adInteger
    With tbl2.Columns("ReqId")
        Set .ParentCatalog = cat
        .Properties("AutoIncrement") = True
        .Properties("Increment") = CLng(1)
        Set .ParentCatalog = nothing 'untested row: comment out if you have a problem
    End With

Denis

 

[baha17]

Hi Denis,

That comment part give an error 3001:
"Arguments are of the two wrong type, are out of acceptable range, or are in conflict with one another"

Thank you
Baha

 

[SydneyGeek]

OK, it looks like you need to do the building in a couple of steps.
Here is a tested, working example (Access 2010) :

Option Explicit
Const TARGET_DB = "DB_test1.mdb"

Sub CreateDB_And_Table()

    Dim cat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim sDB_Path As String

    sDB_Path = ActiveWorkbook.Path & Application.PathSeparator & TARGET_DB

    'delete the DB if it already exists
    On Error Resume Next
    Kill sDB_Path
    On Error GoTo 0

    'create the new database
    Set cat = New ADOX.Catalog
    cat.Create _
      "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & sDB_Path & ";"

    'create the table
    Set tbl = New ADOX.Table
    tbl.Name = "tblPopulation"

    'create the fields for the new table
    tbl.Columns.Append "PopID", adInteger
    With tbl.Columns("PopID")
        Set .ParentCatalog = cat
        .Properties("AutoIncrement") = True
        .Properties("Increment") = CLng(1)
    End With
    tbl.Columns.Append "Country", adVarWChar, 60
    tbl.Columns.Append "Yr_1950", adDouble
    tbl.Columns.Append "Yr_2000", adDouble
    tbl.Columns.Append "Yr_2015", adDouble
    tbl.Columns.Append "Yr_2025", adDouble
    tbl.Columns.Append "Yr_2050", adDouble

    'append the newly defined table to the Tables collection in the database
    cat.Tables.Append tbl

    'now create the primary key: added 06 Oct 2010
    Call CreatePrimaryKey(cat, "tblPopulation", "PopID")
    
    'Clean up references
    Set cat = Nothing

End Sub

Private Sub CreatePrimaryKey(cat As ADOX.Catalog, strTableName As String, _
        varPKColumn As Variant)
    Dim tbl As ADOX.Table
    Dim idx As ADOX.Index
    Dim sDB_Path As String
    Dim MyConn
    
    
    Set tbl = cat.Tables(strTableName)
    
    'delete any existing primary keys
    For Each idx In tbl.Indexes
        If idx.PrimaryKey Then
            tbl.Indexes.Delete idx.Name
        End If
    Next idx
    
    'create a new primary key
    Set idx = New ADOX.Index
    With idx
        .PrimaryKey = True
        .Name = "PrimaryKey"
        .Unique = True
    End With
    
    'append the column
    idx.Columns.Append varPKColumn
    
    'append the index to the collection
    tbl.Indexes.Append idx
    tbl.Indexes.Refresh
    
    'clean up references
    Set tbl = Nothing
    Set idx = Nothing
    
End Sub

Note that the index is created in a separate subroutine, once the table and fields have been appended.
By passing the catalog reference to the second sub there is no need to rebuild the connection / catalog refs.

Denis

 

[baha17]

Hi Denis,

I cannot check it out yet,that will be my first thing to try tomorrow.
Thank you for your help

Baha