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.

CodePudding user response：

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

CodePudding user response：

Here is a very simple code snippet that should get you started

Option Compare Database
Option Explicit
Sub sbMakeQry()
 
 ' The next three lines create a query definition in the database
 'Dim strQry As String
 'strQry = "SELECT * FROM CUSTOMERS WHERE COUNTRY = 'UK'"
 'CurrentDb.CreateQueryDef "MyQuery", strQry
 
 ' This line will open your query
 'DoCmd.OpenQuery "MyQuery", acViewNormal, acEdit
 
End Sub

1. Automated creation of a query
2. The query is a SELECT query based on one of the columns in the table

Take it from here.