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

 

[baha17]

Hi Denis,

It worked but there is only one problem though.Once I run the above code seems like access DB keep open.Because in that case I won't be able to delete if DB exists.Once I run the code,cannot run again,it gives database already exists.Can I get ride of that error?
Thanks million for your help
baha

 

[SydneyGeek]

There's a connection left open by something I changed in the code, and I haven't found where yet. Close the workbook and reopen it, and the Access lock goes away (workaround, not a perfect solution)

Denis

 

[baha17]

Hi Denis,

I added a line at the end of the first code then the problem is solved.
Thank you very much for your help. Everything is working fine now.
Cheers
Baha

'now create the primary key: added 06 Oct 2010
Call CreatePrimaryKey(cat, "tblPopulation", "PopID")

cat.ActiveConnection.Close
'Clean up references
Set cat = Nothing