Adding table into existing access database via ADO

[baha17]

Dear All,

I have a following code that add customer ratings into our database. It will create a .mdb as per the customer number correspondes Range("PlayerId"). If the PlayerId is inuque, there is no problem with my code. However what I want is; if the DB file exists,to create another table as per value in Range("tblName"). Below is my code:
Thank you very much for your kind attention.
Baha

Option Explicit
Sub CreateDB_StaffReq()
    Dim cat As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim sDB_Path, sDB_PathBackUp As String
    Dim cnn As ADODB.Connection
    sDB_Path = "P:\Everyone\For Baha\RatingCalculator\" & "DB_" & Sheets("Data").Range("PlayerId").Value & ".mdb"
    
    'On Error Resume Next
    'FileCopy sDB_Path, sDB_PathBackUp
    '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 tbl = New ADOX.Table
    tbl.Name = "tbl" & Format(Range("tblName"), "hh:mm")
    tbl.Columns.Append "GameId", adInteger
    With tbl.Columns("GameId")
        Set .ParentCatalog = cat
         .Properties("AutoIncrement") = True
         .Properties("Increment") = CLng(1)
    End With
    tbl.Columns.Append "Wagers", adVarWChar, 15
    '-------------------------------------
    cat.Tables.Append tbl
    Call CreatePrKey_tblPlayerId(cat, "tbl" & Format(Range("tblName"), "hh:mm"), "GameId")
    cat.ActiveConnection.Close
    Set cat = Nothing
End Sub
Private Sub CreatePrKey_tblPlayerId(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)
    For Each idx In tbl.Indexes
        If idx.PrimaryKey Then
            tbl.Indexes.Delete idx.Name
        End If
    Next idx
    Set idx = New ADOX.Index
    With idx
        .PrimaryKey = True
        .Name = "PrimaryKey"
        .Unique = True
    End With
    idx.Columns.Append varPKColumn
    tbl.Indexes.Append idx
    tbl.Indexes.Refresh
    Set tbl = Nothing
    Set idx = Nothing
    
End Sub
Sub PushTableToAccess_PlayerRating()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
    Dim i As Long, j As Long
    Dim Rw As Long
    Sheets("Data").Activate
    Rw = Cells(65536, Range("ColNum").Value).End(xlUp).Row
    Set cnn = New ADODB.Connection
    MyConn = "P:\Everyone\For Baha\RatingCalculator\" & "DB_" & Sheets("Data").Range("PlayerId").Value & ".mdb"
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Open MyConn
    End With
    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="tbl" & Format(Range("tblName"), "hh:mm"), ActiveConnection:=cnn, _
             CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
             Options:=adCmdTable
    
    For i = 3 To Rw
        rst.AddNew
            rst(1) = Cells(i, 1).Value
        rst.Update
    Next i
    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub