从Excel VBA检查MS Access中是否存在查询

Question

以下函数适用于通过标准新连接和记录集**在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

我怎样才能改变它来找到它们？

感谢您的时间和帮助。

Answer 1

如果可以查询MSysObjects表会很好，但由于权限问题，这在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