Function DeleteAllTables()
'Created by: Neal A. Kling
'Created : 4/22/99 9:54:31 AM
On Error GoTo Err_DeleteAllTables
Dim db As Database
Dim doc As Document
Dim tbf As TableDef
DoCmd.Hourglass True
'Set db = DBEngine(0)(0)
Set db = DBEngine.OpenDatabase("c:\test\data.mdb"
For Each tbf In db.TableDefs
DoEvents
If Not Left(tbf.Name, 4) = "MSys" Then
'don't delete system tables
db.TableDefs.Delete tbf.Name
End If
Next tbf
Exit_DeleteAllTables:
On Error Resume Next
DoCmd.Hourglass False
db.Close
Set db = Nothing
Exit Function
Err_DeleteAllTables:
Select Case Err
Case 0 'insert Errors you wish to ignore here
Resume Next
Case 3011 'object not found
Resume Next
' Case 3045 'database already in use
' Beep
' MsgBox
Case Else 'All other errors will trap
Beep
MsgBox "Error deleting tables.@" & Err.Number & "; " & Err.Description
Resume Exit_DeleteAllTables
End Select
Resume 0 'FOR TROUBLESHOOTING
End Function
"The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!"
Thanks for this code. I am finding that it only deletes every second table... probably because it deletes the first tabledef then goes to the second tabledef, but the tables have now been renumbered and the second is in fact first etc... get me?
I had a do loop working for a while, but ever since I got the "Cannot delete Msys ...." error it no longer works, even when incorporating the NOT... "Msys" code...
Yes, I think you're right. That'll teach me to bang something in off the top of my head without testing it. I've made some modifications. Basically I start with the last one in the collection and then decrement until I get to the beginning, thereby avoiding the renumbering problem.
You'll also notice that I've added another error to ignore. Access won't delete a table if it's used in a relationship. So you'll have to get rid of them first.
There is a relationships collection just like a table collection. You could modify the below code to loop through the relationships and get rid of them also. I'll leave that up to you though
Function DeleteAllTables()
'Created by: Neal A. Kling
'Created : 4/22/99 9:54:31 AM
On Error GoTo Err_DeleteAllTables
Dim db As Database
Dim doc As Document
Dim tbf As TableDef
Dim i As Integer
DoCmd.Hourglass True
'Set db = DBEngine(0)(0)
Set db = DBEngine.OpenDatabase("c:\test\data.mdb"
'For Each tbf In db.TableDefs
i = db.TableDefs.Count - 1
Do Until i = 0
DoEvents
Set tbf = db.TableDefs(i)
If Not Left(tbf.Name, 4) = "MSys" Then
'don't delete system tables
Debug.Print tbf.Name
db.TableDefs.Delete tbf.Name
End If
i = i - 1 'go to next table
Loop
'Next tbf
MsgBox "done"
Exit_DeleteAllTables:
On Error Resume Next
DoCmd.Hourglass False
db.Close
Set db = Nothing
Exit Function
Err_DeleteAllTables:
Select Case Err
Case 0 'insert Errors you wish to ignore here
Resume Next
Case 3281 'used in relationship
Resume Next
Case 3011 'object not found
Resume Next
' Case 3045 'database already in use
' Beep
' MsgBox
Case Else 'All other errors will trap
Beep
MsgBox "Error deleting tables. " & Err.Number & "; " & Err.Description
Resume Exit_DeleteAllTables
End Select
Resume 0 'FOR TROUBLESHOOTING
End Function
"The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!"
Do Until i = -1, not zero, else it won't delete that last one because it's index is 0.
A curious thing: I imported a bunch of tables with relationships and it doesn't delete the first one with a relationship, but does the rest. If I run the function again it goes ahead and deletes that one as well. When I look at the relationships they are gone. I can't explain this behaviour and I'm not going to explore it now.
"The Key, The Whole Key, and Nothing But The Key, So Help Me Codd!"
This site uses cookies to help personalise content, tailor your experience and to keep you logged in if you register.
By continuing to use this site, you are consenting to our use of cookies.