Is there a way in MS-Access to delete the data in all the tables at once. We run a database in access, save the data every month and then delete all the data in access. But it requires deleting data from a lot of tables. Isn't there a simpler/easier way to do so?
Why don't you keep an empty copy of the database on hand. At the end of the month, save the existing database, then copy the empty database in its place.
Craig's answer is simple and sensible. If you really want a programmatic solution, the following VBA script will clear all the data from every table excluding the hidden tables. It requires DAO to be enabled - in Visual Basic Editor, go to Tools -> References, and tick Microsoft DAO 3.6 Object Library, then OK:
Public Sub TruncateTables()
'Majority of code taken from a data dictionary script I can no longer source nor find the author
On Error GoTo Error_TruncateTables
Dim DB As DAO.Database
Dim TDF As DAO.TableDef
Dim strSQL_DELETE As String
Set DB = CurrentDb()
For Each TDF In DB.TableDefs
If Left(TDF.Name, 4) <> "MSys" Then
strSQL_DELETE = "DELETE FROM " & TDF.Name & ";"
DB.Execute strSQL_DELETE
End If
Next
MsgBox "Tables have been truncated", vbInformation, "TABLES TRUNCATED"
DB.Close
Exit_Error_TruncateTables:
Set TDF = Nothing
Set DB = Nothing
Exit Sub
Error_TruncateTables:
Select Case Err.Number
Case 3376
Resume Next 'Ignore error if table not found
Case 3270 'Property Not Found
Resume Next
Case Else
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Error_TruncateTables
End Select
End Sub
Great answer from Alistair, although it needs to be updated. The old if statement would cause errors, and the old dynamic string wouldn't work on tables with names that have a space. It would treat a name like "person information" as "person". I've updated the code, as well as made it a little easier to add exceptions to the if statement, if you want some tables to retain their data.
Public Sub TruncateTables()
'Majority of code taken from a data dictionary script I can no longer source nor find the author
On Error GoTo Error_TruncateTables
Dim DB As DAO.Database
Dim TDF As DAO.TableDef
Dim strSQL_DELETE As String
Set DB = CurrentDb()
For Each TDF In DB.TableDefs
If Not (TDF.Name Like "MSys*" Or TDF.Name Like "~*" Or Len(TDF.Connect) > 0) Then
'This will prevent system, temporary and linked tables from being cleared
strSQL_DELETE = "DELETE FROM " & "[" & TDF.Name & "]"
DB.Execute strSQL_DELETE
End If
Next
MsgBox "Tables have been truncated", vbInformation, "TABLES TRUNCATED"
DB.Close
Exit_Error_TruncateTables:
Set TDF = Nothing
Set DB = Nothing
Exit Sub
Error_TruncateTables:
Select Case Err.Number
Case 3376
Resume Next 'Ignore error if table not found
Case 3270 'Property Not Found
Resume Next
Case Else
MsgBox Err.Number & ": " & Err.Description
Resume Exit_Error_TruncateTables
End Select
End Sub
Since this is a repetitive action, it would be better if you made a simple SQL script to do this.
DELETE FROM <table1>;
DELETE FROM <table2>;
...
DELETE FROM <tablen>;
Highlight all of the ROWS and then press the Delete key on your keyboard. If access is doing that thing were it doesn't let you go to the bottom,then go into a cell and click ctrl+down arrow. To highlight all rows, highlight the top row and then scroll to the bottom row and hold down shift while you select the bottom row. All rows should be highlighted.
This will delete all the data from all tables except from System Tables
Dim T As TableDef
DoCmd.SetWarnings False
For Each T In CurrentDb.TableDefs
If T.Name Like "d2s_*" Then
DoCmd.RunSQL "DELETE * FROM " & T.Name
End If
Next T
DoCmd.SetWarnings True
Another approach: (Based on Suggestion of Christopher Duke)
Dim T As TableDef
DoCmd.SetWarnings False
For Each T In CurrentDb.TableDefs
If Not Left(T.Name, 4) = "MSys" Then
DoCmd.RunSQL "DELETE * FROM [" & T.Name & "]"
End If
Next T
DoCmd.SetWarnings True
Related
I'm trying to automate the creation of queries in my access database using VBA. I currently have a table with over 1000 entries with four columns (id, name, last name & age) and i want it to automatically create queries for each number found in the "age" column. For example, if in the list of 1000 there are only 10 people that are 40 years old, then i want it to create a query named "Age 40" and only shown the name and last name of those 10 people and do the same for all the other ages.
New to access vba so i dont know where to start.
Firstly, you should not be storing the age in a table - it should be calculated as needed (what happens tomorrow - chances are some of the people will have a birthday)
Anyway, consider using a recordset to get a list of the unique ages, and then using that to create each query. Something like:
Sub sAgeQuery1()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsSteer As DAO.Recordset
Dim qdf As DAO.QueryDef
Set db = CurrentDb
Set rsSteer = db.OpenRecordset("SELECT DISTINCT Age FROM tblAge ORDER BY Age ASC;")
If Not (rsSteer.BOF And rsSteer.EOF) Then
Do
Set qdf = db.CreateQueryDef("qryAge" & rsSteer!Age, "SELECT * FROM tblAge WHERE Age=" & rsSteer!Age & " ORDER BY LastName, [Name];")
rsSteer.MoveNext
Loop Until rsSteer.EOF
db.QueryDefs.Refresh
End If
sExit:
On Error Resume Next
Set qdf = Nothing
rsSteer.Close
Set rsSteer = Nothing
Set db = Nothing
Exit Sub
E_Handle:
Select Case Err.Number
Case 3012 ' query already exists
Resume Next
Case Else
MsgBox Err.Description & vbCrLf & vbCrLf & "sAgeQuery1", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Select
End Sub
However, this is probably not the way to do it - you have not said why you think you need to create all of these queries. Possibly a better way would be to have just one query, and alter the SQL in the recordset's loop before doing something with the query:
Sub sAgeQuery2()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim rsSteer As DAO.Recordset
Dim qdf As DAO.QueryDef
Set db = CurrentDb
Set rsSteer = db.OpenRecordset("SELECT DISTINCT Age FROM tblAge ORDER By Age ASC;")
If Not (rsSteer.BOF And rsSteer.EOF) Then
Set qdf = db.CreateQueryDef("qryAge")
Do
qdf.SQL = "SELECT * FROM tblAge WHERE Age=" & rsSteer!Age
' do something with this query (export as an excel/csv file perhaps)
rsSteer.MoveNext
Loop Until rsSteer.EOF
End If
sExit:
On Error Resume Next
rsSteer.Close
Set rsSteer = Nothing
DoCmd.DeleteObject acQuery, "qryAge"
Set qdf = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sAgeQuery2", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
I have the following code that is supposed to unlink all Access 2003 tables that are listed in one table and link SQL tables, but it gives error: 3265 Item not found in this collection. The table is not empty, I don't know what is the problem.
Sub LinkODBC()
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim connString As String
Dim rs As DAO.Recordset
Set db = CurrentDb()
connString = "ODBC;Driver={ODBC Driver 17 for SQL Server};Server=192.168.0.4;Database=testdbAllTables;Trusted_Connection=Yes;UID=sa;PWD=tv$akP4O30HM1TO2!9lI2z6c"
Set rs = db.OpenRecordset("SELECT Name FROM SysTrafficLinkTbls")
Do While Not rs.EOF
' Deletes Access table if exists
db.TableDefs.Delete rs!Name
' Link table
Set td = CurrentDb.CreateTableDef(rs!Name, dbAttachSavePWD, "dbo." & rs!Name, connString)
db.TableDefs.Append td
rs.MoveNext
Loop
End Sub
Consider this segment of your code:
' Deletes Access table if exists
db.TableDefs.Delete rs!Name
The comment says to delete the table if it exists. However your code will attempt to delete a table whether or not it exists. And when the table doesn't exist, attempting to delete it triggers that 3265 error: "Item not found in this collection."
There are two approaches you can use to avoid that error.
Check whether the table exists and only attempt the delete when it does exist.
Revise the code to ignore the 3265 error.
The sample code you included in your previous question uses the first approach. It looks through the TableDefs collection to see if the table is present, and only calls db.TableDefs.Delete when the table is found.
Here's an example of the second approach.
On Error GoTo LinkODBC_Err
Set db = CurrentDb()
connString = "ODBC;Driver={ODBC Driver 17 for SQL Server};Server=192.168.0.4;Database=testdbAllTables;Trusted_Connection=Yes;UID=sa;PWD=tv$akP4O30HM1TO2!9lI2z6c"
Set rs = db.OpenRecordset("SELECT [Name] FROM SysTrafficLinkTbls")
Do While Not rs.EOF
' Delete Access table
db.TableDefs.Delete rs!Name
' Link table
Set td = CurrentDb.CreateTableDef(rs!Name, dbAttachSavePWD, "dbo." & rs!Name, connString)
db.TableDefs.Append td
rs.MoveNext
Loop
LinkODBC_Exit:
Exit Sub
LinkODBC_Err:
Select Case Err.Number
Case 3265 'Item not found in this collection
Resume Next ' ignore the error and continue on
Case Else
' for any other errors, notify the user and exit
MsgBox Err.Number & ": " & Err.Description
Resume LinkODBC_Exit
End Select
End Sub
There are a few ways to do this. Here's one option.
DoCmd.TransferDatabase _
acImport, _
"ODBC Database", _
"ODBC;Driver={SQL Server};Server=Fos;Database=Hermes;Trusted_Connection=Yes", _
acTable, _
"sourceTable", _
"targetTable"
In MS Access, using VBA, I need to list all actions in a macro, so that I can see what dependencies that macro has: what queries or additional macros it launches.
With the following query I can retrieve a list of all the macros in a database:
SELECT Name, Type, DateCreate, DateUpdate FROM MsysObjects
WHERE (Name Not Like '~*') And (Name Not Like 'MSys*')
And Type=-32766
ORDER BY Name;
Is there anything like a 'MacroDef' object, similar to TableDef or QueryDef, that could provide further details of a macro?
Might there be any profane hidden system table which stored the list of actions in a macro?
Thanks a lot for any tip or guidance to move forward on this.
You may have some luck using the undocumented .SaveAsText method to output the information to a text file, and then read these text files back in using VBA. Try something like:
Sub sExportObjects()
On Error GoTo E_Handle
Dim db As DAO.Database
Dim cnt As Container
Dim doc As Document
Dim strFolder As String
strFolder = "J:\downloads\test\"
Set db = DBEngine(0)(0)
Set cnt = db.Containers("Scripts")
For Each doc In cnt.Documents
Application.SaveAsText acMacro, doc.name, strFolder & "macro_" & doc.name & ".txt"
Next doc
sExit:
On Error Resume Next
Set cnt = Nothing
Set db = Nothing
Exit Sub
E_Handle:
MsgBox Err.Description & vbCrLf & vbCrLf & "sExportObjects", vbOKOnly + vbCritical, "Error: " & Err.Number
Resume sExit
End Sub
Regards,
I'm trying to add several new columns to a table that already exists in Access 2007 or 2010 with a query. Right now my code looks like this (yes, I'm terribly new to this):
ALTER TABLE AC_PROPERTY
ADD JAB_1 double,
JAB_2 double,
JAB_3 double;
This correctly adds the three columns when none of them already exist, but if any of them exist I get an error message and the query fails to run. I need it to add each columns only if it does not exist. Can anyone please help with what my code should look like to check if each column exists before trying to add it?
NOTE: I would just do 3 queries for each column, but I actually need to add 20+ columns. This is just a simple example of my actual use.
Thanks a billion!
Here is some old code.... it would be better to just check all fields in the same subroutine rather than opening/closing the DB, TDF, etc.
Option Compare Database
Option Explicit
Function Check_If_Exists()
Dim strStatus As String
' Add calls for the fields you want to append
strStatus = Add_Field("MyFLd2", "Double")
If strStatus = "Exists" Then
Debug.Print "field present"
ElseIf strStatus = "Added" Then
Debug.Print "field added"
End If
End Function
Function Add_Field(strFN, strType) As String
Dim db As DAO.Database
Dim td As DAO.TableDef
Dim fd As DAO.Field
Dim strSQL As String
On Error GoTo Error_Trap
Set db = CurrentDb
Set td = db.TableDefs("Table1")
' ' List all field names
' For Each fd In td.Fields
' Debug.Print fd.Name
' Next fd
If IsNull(td.Fields(strFN)) Then
Add_Field = "Exists"
End If
Set fd = Nothing
Set td = Nothing
Set db = Nothing
Exit Function
Error_Trap:
Debug.Print Err.Number & vbTab & Err.Description
If Err.Number = 3265 Then
Add_Field = "Added"
strSQL = "alter table Table1 ADD " & strFN & " " & strType & ";"
db.Execute strSQL
db.TableDefs.Refresh
End If
Exit Function
Resume
End Function
I'm trying to delete all the linked tables in my front end, but it fails on the first table with the error: 3125 "'attendeesSearch' is not a valid name. Make sure that it does not include invalid characters or punctuation and that it is not too long.".
This table contains a multi-valued field. I include this because it may be an issue.
I've tried using "Drop table..." SQL and DoCmd.DeleteObject method.
My routine:
Sub relinkRequestHelp()
Const csConnnectPrefix As String = ";DATABASE="
Dim bLenConnectPrefix As Byte
Dim db As dao.Database
Dim tbl As dao.TableDef
Dim s As String
On Error GoTo eh
bLenConnectPrefix = Len(csConnnectPrefix)
Set db = CurrentDb()
For Each tbl In db.TableDefs
If Left(tbl.Connect, bLenConnectPrefix) = csConnnectPrefix Then
' s = "DROP TABLE " & tbl.Name & ";"
' Debug.Print s
' db.Execute s, dbFailOnError
' Debug.Print , db.RecordsAffected
DoCmd.DeleteObject acTable, tbl.Name
End If
Next
Exit Sub
eh: Debug.Print Err.Number, Err.Description
End Sub
Any suggestions?
Delete the current object from the collection. That works for me:
For Each tbl In db.TableDefs
If Left(tbl.Connect, bLenConnectPrefix) = csConnnectPrefix Then
db.TableDefs.Delete tbl.Name
End If
Next
In this post, Daniel Pineault suggested I remove the troubled table from all relationships.
Once I did that, I was able to delete the linked table.