删除所有表中数据的程序

Sub 删除所有表的数据()
Dim obj As AccessObject, dbs As Object
Set dbs = Application.CurrentData
Dim s as String
Dim q as Integer
DoCmd.SetWarnings False '关闭系统提示
q=msgbox("将要删除本数据库中所有表的数据，请确认是否删除",vbOKCancel ,"删除提示")
if q=1 then
For Each obj In dbs.AllTables
 If mid(obj.Name,1,4)<>"MSys"  Then '除系统表外
  s="delete * from " & obj.Name
  docmd.runsql(s)
 End If
Next obj
DoCmd.SetWarnings True '打开系统提示
end if
End Sub