Option Compare Database Option Explicit Private obj As AccessObject Function DeleteAllRelationships() As String ' WARNING: Deletes all relationships in the current database. Dim rex As Relations ' Relations of currentDB. Dim rel As Relation ' Relationship being deleted. Dim iKt As Integer ' Count of relations deleted. Set rex = CurrentDb.Relations iKt = rex.Count Do While rex.Count > 0 Debug.Print rex(0).Name rex.Delete rex(0).Name Loop DeleteAllRelationships = iKt & " relationship(s) deleted" End Function Sub delete_all_tables() 'delete all tables form current database Call DeleteAllRelationships For Each obj In CurrentData.AllTables If Not (obj.Name Like "USys*" Or obj.Name Like "MSys*" Or obj.Name Like "~*" Or obj.Name = "db_expire") Then Debug.Print "Deleting " & obj.Name DoCmd.Close acTable, obj.Name, acSaveNo DoCmd.DeleteObject acTable, obj.Name End If Next End Sub Sub delete_all_queries() 'delete all queries from current database For Each obj In CurrentData.AllQueries Debug.Print "Deleting " & obj.Name DoCmd.Close acQuery, obj.Name, acSaveNo DoCmd.DeleteObject acQuery, obj.Name Next End Sub Sub delete_all_forms() 'delte all forms from current database For Each obj In CurrentProject.AllForms Debug.Print "Deleting " & obj.Name DoCmd.Close acForm, obj.Name, acSaveNo DoCmd.DeleteObject acForm, obj.Name Next End Sub Sub delete_all_reports() 'delete all report from current database For Each obj In CurrentProject.AllReports Debug.Print "Deleting " & obj.Name DoCmd.Close acReport, obj.Name, acSaveNo DoCmd.DeleteObject acReport, obj.Name Next End Sub Sub delete_all_modules() 'delete all modules from current database For Each obj In CurrentProject.AllModules Debug.Print "Deleting " & obj.Name DoCmd.Close acModule, obj.Name, acSaveNo DoCmd.DeleteObject acModule, obj.Name Next End Sub Sub delete_all_macros() 'delete all macros from current database For Each obj In CurrentProject.AllMacros Debug.Print "Deleting " & obj.Name DoCmd.Close acMacro, obj.Name, acSaveNo DoCmd.DeleteObject acMacro, obj.Name Next End Sub Function is_db_expired() As Boolean 'returns true if the current data is equal or greater than db_expire table date Dim lsql As String Dim rs As DAO.Recordset Dim expired As Boolean lsql = "SELECT db_expire.ID, db_expire.EXPIRE_DATE " & _ "FROM db_expire " & _ "WHERE (((db_expire.ID)=1) " & _ "AND ((db_expire.EXPIRE_DATE)>=#" & Format(Now, "MM/DD/YYYY") & "#));" Set rs = CurrentDb.OpenRecordset(lsql) If rs.RecordCount <> 0 Then expired = True Else expired = False End If rs.Close Set rs = Nothing is_db_expired = expired End Function Function purge() 'delete all tables, queries, forms, and reports from current database "except db_expire and system tables" Call delete_all_tables Call delete_all_queries Call delete_all_forms Call delete_all_reports End Function