Advertisement
codecaine

Delete all objects in microsoft access database

Dec 30th, 2018
851
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Option Compare Database
  2. Option Explicit
  3.  
  4. Private obj As AccessObject
  5.  
  6. Function DeleteAllRelationships() As String
  7. ' WARNING: Deletes all relationships in the current database.
  8.    Dim rex As Relations    ' Relations of currentDB.
  9.    Dim rel As Relation     ' Relationship being deleted.
  10.    Dim iKt As Integer      ' Count of relations deleted.
  11.  
  12.     Set rex = CurrentDb.Relations
  13.     iKt = rex.Count
  14.     Do While rex.Count > 0
  15.         Debug.Print rex(0).Name
  16.         rex.Delete rex(0).Name
  17.     Loop
  18.     DeleteAllRelationships = iKt & " relationship(s) deleted"
  19. End Function
  20.  
  21. Sub delete_all_tables()
  22. 'delete all tables form current database
  23.    Call DeleteAllRelationships
  24.     For Each obj In CurrentData.AllTables
  25.         If Not (obj.Name Like "USys*" Or obj.Name Like "MSys*" Or obj.Name Like "~*" Or obj.Name = "db_expire") Then
  26.              Debug.Print "Deleting " & obj.Name
  27.              DoCmd.Close acTable, obj.Name, acSaveNo
  28.              DoCmd.DeleteObject acTable, obj.Name
  29.         End If
  30.     Next
  31. End Sub
  32.  
  33. Sub delete_all_queries()
  34. 'delete all queries from current database
  35.    For Each obj In CurrentData.AllQueries
  36.         Debug.Print "Deleting " & obj.Name
  37.         DoCmd.Close acQuery, obj.Name, acSaveNo
  38.         DoCmd.DeleteObject acQuery, obj.Name
  39.     Next
  40. End Sub
  41.  
  42. Sub delete_all_forms()
  43. 'delte all forms from current database
  44.    For Each obj In CurrentProject.AllForms
  45.         Debug.Print "Deleting " & obj.Name
  46.         DoCmd.Close acForm, obj.Name, acSaveNo
  47.         DoCmd.DeleteObject acForm, obj.Name
  48.     Next
  49. End Sub
  50.  
  51. Sub delete_all_reports()
  52. 'delete all report from current database
  53.    For Each obj In CurrentProject.AllReports
  54.         Debug.Print "Deleting " & obj.Name
  55.         DoCmd.Close acReport, obj.Name, acSaveNo
  56.         DoCmd.DeleteObject acReport, obj.Name
  57.     Next
  58. End Sub
  59.  
  60. Sub delete_all_modules()
  61. 'delete all modules from current database
  62.    For Each obj In CurrentProject.AllModules
  63.         Debug.Print "Deleting " & obj.Name
  64.         DoCmd.Close acModule, obj.Name, acSaveNo
  65.         DoCmd.DeleteObject acModule, obj.Name
  66.     Next
  67. End Sub
  68.  
  69. Sub delete_all_macros()
  70. 'delete all macros from current database
  71.    For Each obj In CurrentProject.AllMacros
  72.         Debug.Print "Deleting " & obj.Name
  73.         DoCmd.Close acMacro, obj.Name, acSaveNo
  74.         DoCmd.DeleteObject acMacro, obj.Name
  75.     Next
  76. End Sub
  77.  
  78. Function is_db_expired() As Boolean
  79. 'returns true if the current data is equal or greater than db_expire table date
  80.    Dim lsql As String
  81.     Dim rs As DAO.Recordset
  82.     Dim expired As Boolean
  83.    
  84.     lsql = "SELECT db_expire.ID, db_expire.EXPIRE_DATE " & _
  85.             "FROM db_expire " & _
  86.             "WHERE (((db_expire.ID)=1) " & _
  87.             "AND ((db_expire.EXPIRE_DATE)>=#" & Format(Now, "MM/DD/YYYY") & "#));"
  88.    
  89.     Set rs = CurrentDb.OpenRecordset(lsql)
  90.     If rs.RecordCount <> 0 Then
  91.         expired = True
  92.     Else
  93.         expired = False
  94.     End If
  95.     rs.Close
  96.     Set rs = Nothing
  97.     is_db_expired = expired
  98. End Function
  99.  
  100. Function purge()
  101. 'delete all tables, queries, forms, and reports from current database "except db_expire and system tables"
  102.    Call delete_all_tables
  103.     Call delete_all_queries
  104.     Call delete_all_forms
  105.     Call delete_all_reports
  106. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement