How to use vba to automate the creation of queries in access - vba

Question

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.

Answer 1

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