The following function will loop through all the tables within the current database, excluding system tables, and delete all their records.

As always, such actions cannot be undone, so be sure to make a backup copy of your database prior to executing the function just in case.

'---------------------------------------------------------------------------------------
' 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 Occurred! "
    Exit Function
End Function