Pasted

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