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