检查来自 Excel VBA 的 MS Access 中是否存在查询

Check if a Query exists in MS Access from Excel VBA

以下函数可以很好地通过标准的新连接和记录集在 MS Access 数据库中查找表**但它不会查找查询或链接表。

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

如何更改此设置以找到它们?

非常感谢您抽出时间提供帮助。

如果可以查询 MSysObjects 就好了 table 但由于权限问题,这在 Access 之外是不可靠的。它对我来说失败了。

设置对 Microsoft Office x.x Access Database Engine Library 的 VBA 引用。

一种方法使用 QueryDefs 集合。经过测试并为我工作。但是,这两个文件都在同一用户文件夹中的笔记本电脑上。

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

如果您想避免 QueryDefs,请尝试错误处理程序代码:

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

对于 ADODB 版本,设置参考 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