Deleting access db table using excel vba

baha17

Board Regular
Joined
May 12, 2010
Messages
181
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:
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
 

Some videos you may like

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)

baha17

Board Regular
Joined
May 12, 2010
Messages
181
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:
Code:
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

Well-known Member
Joined
Mar 13, 2006
Messages
1,295
Office Version
  1. 365
Platform
  1. Windows
If you're recreating exactly the same table each time - couldn't you just delete the contents of the old table?

Code:
.
.
.Execute "DELETE * FROM tblStaff"
.
.
 

baha17

Board Regular
Joined
May 12, 2010
Messages
181
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,437
Messages
5,596,130
Members
414,043
Latest member
thomas Stein

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top