PDA

View Full Version : [SOLVED] creating a access db with autonumber primary Key



baha17
07-02-2018, 11:27 PM
Dear All, I have a code with helps me to create a db then I need to enter some customer data. It was working fine until I decided to add one more auto number primary key column. I kind of could not work it out how I manage to have my "RaitingID" column as auto number. Can some one give me a hand please? thank you guys in advance. Baha
Option Explicit
Const TARGET_DB1 = "DB_PlayerMasterManual.mdb"
Const CopyTarget_DB1 = "DB_PlayerMasterManualBackUp.mdb"

Sub Create_NewPlayerMasterDB()
Dim cat, cat2 As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sDB_Path, sDB_PathBackUp As String
Dim cnn As ADODB.Connection

sDB_Path = "J:\Gaming Common\PlayerMaster_Manual" & "\" & "DataFiles\" & TARGET_DB1
sDB_PathBackUp = "J:\Gaming Common\PlayerMaster_Manual" & "\" _
& "BackUpDataFiles\" & Range("CheckInFileName") & CopyTarget_DB1
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 = "tblRating"
tbl.Columns.Append "RatingID", adDouble
tbl.Columns.Append "CustID", adInteger
tbl.Columns.Append "CustName", adVarWChar, 70
tbl.Columns.Append "TimeIn", adVarWChar, 15
tbl.Columns.Append "TimeOut", adVarWChar, 15
tbl.Columns.Append "ChipsIn", adCurrency
tbl.Columns.Append "CashIn", adCurrency
tbl.Columns.Append "AvgBet", adCurrency
tbl.Columns.Append "WL", adCurrency
tbl.Columns.Append "Property", adVarWChar, 10
tbl.Columns.Append "PitID", adVarWChar, 5
tbl.Columns.Append "TableID", adVarWChar, 12
tbl.Columns.Append "GameType", adVarWChar, 10
tbl.Columns.Append "TradingDate", adDate
cat.Tables.Append tbl

Call CreatePrKey_tblRating("tblRating", "RatingID")
Set cat = Nothing
End Sub

Private Sub CreatePrKey_tblRating(strRatingID As String, varPKColumn As Variant)
Dim cnn As ADODB.Connection
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim idx As ADOX.Index
Dim sDB_Path As String
Dim MyConn
sDB_Path = "J:\Gaming Common\PlayerMaster_Manual" & "\" & "DataFiles\" & TARGET_DB1

Set cnn = New ADODB.Connection
MyConn = "J:\Gaming Common\PlayerMaster_Manual" & "\" & "DataFiles\" & TARGET_DB1

With cnn
.Provider = "Microsoft.Jet.OLEDB.4.0"
.Open MyConn
End With

Set cat = New ADOX.Catalog
cat.ActiveConnection = cnn

Set tbl = cat.Tables(strRatingID)

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 cnn = Nothing
Set cat = Nothing
Set tbl = Nothing
Set idx = Nothing

End Sub

baha17
07-03-2018, 12:14 AM
I fixed my problem:)

Sub Create_NewPlayerMasterDB()
'Sheets("MorningFloorMap").Select
Dim cat, cat2 As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sDB_Path, sDB_PathBackUp As String
Dim cnn As ADODB.Connection

sDB_Path = "J:\Gaming Common\PlayerMaster_Manual" & "\" & "DataFiles\" & TARGET_DB1
sDB_PathBackUp = "J:\Gaming Common\PlayerMaster_Manual" & "\" _
& "BackUpDataFiles\" & Range("CheckInFileName") & CopyTarget_DB1
'delete the DB if it already exists
'
On Error Resume Next
FileCopy sDB_Path, sDB_PathBackUp
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 & ";"

Set tbl = New ADOX.Table
tbl.Name = "tblRating"
tbl.Columns.Append "RatingID", adInteger
With tbl.Columns("RatingID")
Set .ParentCatalog = cat
.Properties("AutoIncrement") = True
.Properties("Increment") = CLng(1)
End With
tbl.Columns.Append "CustID", adInteger
tbl.Columns.Append "CustName", adVarWChar, 70
tbl.Columns.Append "TimeIn", adVarWChar, 15
tbl.Columns.Append "TimeOut", adVarWChar, 15
tbl.Columns.Append "ChipsIn", adCurrency
tbl.Columns.Append "CashIn", adCurrency
tbl.Columns.Append "AvgBet", adCurrency
tbl.Columns.Append "WL", adCurrency
tbl.Columns.Append "Property", adVarWChar, 10
tbl.Columns.Append "PitID", adVarWChar, 5
tbl.Columns.Append "TableID", adVarWChar, 12
tbl.Columns.Append "GameType", adVarWChar, 10
tbl.Columns.Append "TradingDate", adDate
cat.Tables.Append tbl

Call CreatePrKey_tblRating("tblRating", "RatingID")
Set cat = Nothing
End Sub

thanks