Deleting access db table using excel vba

[baha17]

Dear All,

I made a code which delete the old access db and create new access db and table daily basis. My code works perfectly fine but I encounter some network problem time to time which keeps locking my db open. Therefore I cannot delete the db on those occasions. All of a sudden I get this idea; instead of deleting the access db itself, I would like to delete the access table and create the new table. To create the code I got some help with ADO procedures so that I am not 100% knowledgeable about the concept. Can anyone help me to alter my code? Below is my code:

Option Explicit
Const TARGET_DB1 = "DB_M_Allocation.mdb"
Const TARGET_DB2 = "DB_S_Allocation.mdb"
Const TARGET_DB3 = "DB_G_Allocation.mdb"
Const TARGET_DB4 = "DB_StaffReq.mdb"
Const TARGET_DB5 = "DB_S_StaffReq.mdb"
Const TARGET_DB6 = "DB_G_StaffReq.mdb"
Const TARGET_DB7 = "CPUsersDB.mdb"
Const TARGET_DB8 = "ColorCodeDB.mdb"
Const TARGET_DB9 = "DB_Staff.mdb"

Const CopyTarget_DB1 = "DB_M_AllocationBackUp.mdb"
Const CopyTarget_DB2 = "DB_S_AllocationBackUp.mdb"
Const CopyTarget_DB3 = "DB_G_AllocationBackUp.mdb"
Const CopyTarget_DB4 = "DB_StaffReqBackUp.mdb"
Const CopyTarget_DB5 = "DB_S_StaffReqBackUp.mdb"
Const CopyTarget_DB6 = "DB_G_StaffReqBackUp.mdb"
Const CopyTarget_DB7 = "CPUsersDBBackUp.mdb"
Const CopyTarget_DB8 = "ColorCodeBackUp.mdb"
Const CopyTarget_DB9 = "DB_StaffBackUp.mdb"
Sub CreateStaffDB()
'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
    
    'XXXXXXXXXXXX FILES PATHs XXXXXXXXXXXXX
    'P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP
    'P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Select Case Format(Time, "hh")
Case Is = 1, 2, 3, 4, 5
Range("CheckInFileName") = Format(Date - 1, "MMM-DD-YYYY") & "_"
Case Else
Range("CheckInFileName") = Format(Date, "MMM-DD-YYYY") & "_"
End Select
    sDB_Path = "P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP" & "\" & "DataFiles\" & TARGET_DB9
    sDB_PathBackUp = "P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP" & "\" _
                        & "BackUpDataFiles\" & Range("CheckInFileName") & CopyTarget_DB9
    '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 = "tblStaff"
    tbl.Columns.Append "StaffId", adInteger
    tbl.Columns.Append "StaffName", adVarWChar, 70
    tbl.Columns.Append "StaffOrgPit", adVarWChar, 10
    tbl.Columns.Append "StaffTime", adVarWChar, 10
    tbl.Columns.Append "StaffCurrPit", adVarWChar, 10
    tbl.Columns.Append "StaffPosition", adVarWChar, 50
    tbl.Columns.Append "SKILL", adVarWChar, 100
    tbl.Columns.Append "BJ", adVarWChar, 10
    tbl.Columns.Append "BNC", adVarWChar, 10
    tbl.Columns.Append "CB", adVarWChar, 10
    tbl.Columns.Append "FAB", adVarWChar, 10
    tbl.Columns.Append "FT", adVarWChar, 10
    tbl.Columns.Append "CR", adVarWChar, 10
    tbl.Columns.Append "SSP", adVarWChar, 10
    tbl.Columns.Append "CW", adVarWChar, 10
    tbl.Columns.Append "FP", adVarWChar, 10
    tbl.Columns.Append "MB", adVarWChar, 10
    tbl.Columns.Append "MDX", adVarWChar, 10
    tbl.Columns.Append "RO", adVarWChar, 10
    tbl.Columns.Append "DRO", adVarWChar, 10
    tbl.Columns.Append "SB", adVarWChar, 10
    tbl.Columns.Append "A-A", adVarWChar, 10
   
   
    
    
    cat.Tables.Append tbl
    
    Call CreatePrKey_tblStaff("tblStaff", "StaffId")
    Set cat = Nothing
End Sub

 

[baha17]

Ok No one replied but I found the solution myself. I found one similar post and did some adjustment/testing. I post here in case someone needs in future:

Sub CreateStaffDB()
    Dim cat, cat2 As ADOX.Catalog
    Dim tbl As ADOX.Table
    Dim sDB_Path, sDB_PathBackUp As String
    Dim cnn As ADODB.Connection
    
    Dim db As DAO.Database           ' THESE FOR DELETING DB TABLE
    Dim tdf As DAO.TableDef
 
    
    Dim strConnectString        As String            ' THESE FOR CREATING NEW DB TABLE
    Dim objConnection           As ADODB.Connection
    Dim strDbPath               As String
    
    
 
Select Case Format(Time, "hh")
Case Is = 1, 2, 3, 4, 5
Range("CheckInFileName") = Format(Date - 1, "MMM-DD-YYYY") & "_"
Case Else
Range("CheckInFileName") = Format(Date, "MMM-DD-YYYY") & "_"
End Select
    sDB_Path = "P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP" & "\" & "DataFiles\" & TARGET_DB9
    sDB_PathBackUp = "P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP" & "\" _
                        & "BackUpDataFiles\" & Range("CheckInFileName") & CopyTarget_DB9
    On Error Resume Next
    FileCopy sDB_Path, sDB_PathBackUp
    'Kill sDB_Path   *** do not delete the existing file  ***
    On Error GoTo 0
    
    '******************* THIS DELETES THE PREVIOUS DB TABLE *****************
        
    Set db = OpenDatabase("P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP" & "\" & "DataFiles\" & TARGET_DB9)
    
    db.TableDefs.Delete "tblStaff"
    
    '************************************************************************
    
    
    'Set database name and DB connection string--------
    strDbPath = "P:\Everyone\For Baha\Gaming Common\Sands_VirtualCP" & "\" & "DataFiles\" & TARGET_DB9
    strConnectString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath & ";"
 
    'Connect Database; insert a new table
    Set objConnection = New ADODB.Connection
    With objConnection
        .Open strConnectString

                 
        .Execute "CREATE TABLE tblStaff ([StaffId] decimal(6), " & _
                 "[StaffName] text(150) WITH Compression, " & _
                 "[StaffOrgPit] text(10) WITH Compression, " & _
                 "[StaffTime] text(10) WITH Compression, " & _
                 "[StaffCurrPit] text(10) WITH Compression, " & _
                 "[StaffPosition] text(10) WITH Compression, " & _
                 "[SKILL] text(100) WITH Compression, " & _
                 "[BJ] text(10) WITH Compression, " & _
                 "[BNC] text(10) WITH Compression, " & _
                 "[CB] text(10) WITH Compression, " & _
                 "[FAB] text(10) WITH Compression, " & _
                 "[FT] text(10) WITH Compression, " & _
                 "[CR] text(10) WITH Compression, " & _
                 "[SSP] text(10) WITH Compression, " & _
                 "[CW] text(10) WITH Compression, " & _
                 "[FP] text(10) WITH Compression, " & _
                 "[MB] text(10) WITH Compression, " & _
                 "[MDX] text(10) WITH Compression, " & _
                 "[RO] text(10) WITH Compression, " & _
                 "[DRO] text(10) WITH Compression, " & _
                 "[SB] text(10) WITH Compression, " & _
                 "[A-A] text(10) WITH Compression) "
    End With
 
 Set objConnection = Nothing
  

End Sub

 

[Darren Bartrup]

If you're recreating exactly the same table each time - couldn't you just delete the contents of the old table?

.
.
.Execute "DELETE * FROM tblStaff"
.
.

 

[baha17]

Darren,
Thanks for the comments.Ideally you are right. But there are two reasons that I do not prefer that.

1. All the staff id numbers (StaffId with the primary key) changes every day. So it has to be replaced. You might also ask me to assign auto number for primary key than based on that I might upload to db. Then it comes my second reason.
2. This database is used by over 100 users continuously, therefore to upload the new data into those db tables takes very long time. But recreating only takes 3 to 10 seconds.

Cheers
Baha