MS Access – VBA – Create a Query

The code below allows you to supply a query name and an SQL statement, and it will create the query for you.

'---------------------------------------------------------------------------------------
' Procedure : CreateQry
' Author    : CARDA Consultants Inc.
' Website   : http://www.cardaconsultants.com
' Purpose   : Create a new query in the current database
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sQryName - Name of the query to create
' sSQL - SQL to use
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' CreateQry "qry_ClientList", "SELECT * FROM Clients ORDER BY ClientName"
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2009-Nov-07                 Initial Release
' 2         2022-11-18              Fixed Error Handler Issue
'---------------------------------------------------------------------------------------
Sub CreateQry(sQryName As String, sSQL As String)
    On Error Resume Next
    Dim db               As DAO.Database
    Dim qdf              As DAO.QueryDef

    Set db = CurrentDb

    With db
        'In the next line we try and delete the query
        'If it exist it will be deleted, otherwise it will raise an error but since
        'we set our error handler to resume next it will skip over it and continue
        'with the creation of the query.
        .QueryDefs.Delete (sQryName)                'Delete the query if it exists
        On Error GoTo Error_Handler             'Reinitiate our standard error handler
        Set qdf = .CreateQueryDef(sQryName, sSQL)   'Create the query
    End With

    db.QueryDefs.Refresh  'Refresh the query list to display the newly created query

Error_Handler_Exit:
    On Error Resume Next
    Set qdf = Nothing
    Set db = Nothing
    Exit Sub

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Source: CreateQry" & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Sub