Adding table into existing access database via ADO

[baha17]

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 Iwant 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

Code:
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