Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- 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
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement