Check if a Query exists in MS Access from Excel VBA

Question

The following function works fine for finding tables in an MS Access database through the standard new connection and recordset **but it does not find queries or linked tables.

Function CHKtablename(TABLECHK As String) As Boolean
Dim conn As New Connection
Dim rs As New Recordset
Dim strconn As String
Dim qry As String
Dim chk As Boolean 
strconn = "provider=Microsoft.Ace.Oledb.12.0;" & " Data source= Source path" & "user id=admin;password=" 
conn.Open(strconn) 
Set rs = conn.Openschema(adschematables) 
    While Not rs.EOF
        If rs.Fields("Table_Name") = TABLECHK Then
            CHKtablename = True
        End If
        rs.Movenext
    Wend
End Function

How can I change this to find them?

I appreciate your time and help.

Answer 1

Would be nice if could query MSysObjects table but that is unreliable outside Access because of permission issue. It failed for me.

Set a VBA reference to Microsoft Office x.x Access Database Engine Library.

One approach uses QueryDefs collection. Tested and works for me. However, both files are on laptop in same user folder.

Sub CHKqueryname()
Dim db As DAO.Database
Dim qd As DAO.QueryDef
Set db = DBEngine.OpenDatabase("C:\Users\June\LL\Umpires.accdb")
For Each qd In db.QueryDefs
    If qd.Name = "GamesSorted" Then
        Debug.Print qd.Name
        Exit Sub
    End If
Next
End Sub

If you want to avoid QueryDefs, try error handler code:

Sub Chkqueryname()
    On Error GoTo Err:
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Set db = DBEngine.OpenDatabase("C:\Users\June\LL\Umpires.accdb")
    Set rs = db.OpenRecordset("query name")
    rs.MoveLast
    Debug.Print rs.RecordCount
Err:
    If Err.Number = 3078 Then MsgBox "query does not exist"
End Sub

For ADODB version, set reference to Microsoft ActiveX Data Objects x.x Library.

Sub CHKqueryname()
    On Error GoTo Err:
    Dim cn As ADODB.Connection
    Dim rs As ADODB.Recordset
    Set cn = New ADODB.Connection
    Set rs = New ADODB.Recordset
    cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source='C:\Users\June\LL\Umpires.accdb'"
    rs.Open "query name", cn, adOpenStatic, adLockReadOnly
    Debug.Print rs.RecordCount
Err:
    If Err.Number = -2147217900 Then MsgBox "query does not exist"
End Sub