DEVelopers HUT

'---------------------------------------------------------------------------------------
' Procedure : WipeTables
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Empty all the tables in a db of all data (wipe the db clean (does not
'             include system tables)
' Copyright : The following code may be used as you please, but may not be resold, as
'             long as the header (Author, Website & Copyright) remains with the code.
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2008-Feb                Initial Release
'---------------------------------------------------------------------------------------
Function WipeTables() As String
On Error GoTo WipeTables_Error
    Dim db As DAO.Database
    Dim td As DAO.TableDefs
 
    Set db = CurrentDb()
    Set td = db.TableDefs
    DoCmd.SetWarnings False 'Turn off confirmation prompt to user
   
    For Each t In td    'loop through all the fields of the tables
        If Left(t.Name, 4) = "MSys" Or Left(t.Name, 1) = "~" Then GoTo Continue
        DoCmd.RunSQL ("DELETE [" & t.Name & "].* FROM [" & t.Name & "];")
Continue:
    Next
 
    DoCmd.SetWarnings True  'Turn back on confirmation prompt to user
    Set td = Nothing
    Set db = Nothing
    WipeTables = True
 
If Err.Number = 0 Then Exit Function
 
WipeTables_Error:
    MsgBox "MS Access has generated the following error" & vbCrLf & vbCrLf & "Error Number: " & _
    Err.Number & vbCrLf & "Error Source: WipeTables" & vbCrLf & _
    "Error Description: " & Err.Description, vbCritical, "An Error has Occured! "
    Exit Function
End Function