Delete (Drop) Tables With No Records
In this project, I wanted to delete all tables with no records. Here's the code to accomplish that goal.
Program Code
' ***********************************************************************
' Delete Tables With Zero Records
' ***********************************************************************
Public Function DeleteTablesWithNoRecords()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim tbl As TableDef
Dim strTableName As String
' ***********************************************************************
' Set the Database Variable
' ***********************************************************************
Set db = CurrentDb()
' ***********************************************************************
' Loop Through All Tables
' ***********************************************************************
For Each tbl In db.TableDefs
' ***********************************************************************
' Exclude System and Temporary Tables
' ***********************************************************************
If Left$(tbl.Name, 4) <> "MSys" And Left$(tbl.Name, 1) <> "~" Then
' ***********************************************************************
' Get The Record Count
' ***********************************************************************
On Error Resume Next
Set rst = CurrentDb.OpenRecordset("SELECT Count(*) AS Total FROM " & tbl.Name & ";")
' ***********************************************************************
' Log Tables With Connect Issues And Skip
' ***********************************************************************
If Err.Number <> 0 Then
Debug.Print tbl.Name
Err.Clear
GoTo ContinueTableScan
End If
If rst!Total = 0 Then
' ***********************************************************************
' Free The Table From the rst Lock
' ***********************************************************************
strTableName = tbl.Name
rst.Close
Set rst = Nothing
' ***********************************************************************
' Drop The Table With Zero Records
' ***********************************************************************
DoCmd.RunSQL "DROP TABLE " & strTableName
Else
' ***********************************************************************
' Clean Up rst For the Next Table
' ***********************************************************************
rst.Close
Set rst = Nothing
End If
End If
ContinueTableScan:
Next tbl
Set db = Nothing
End Function