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外部这是不可靠的。对我来说失败了。

将VBA引用设置为Microsoft Office x.x Access Database Engine Library。

一种方法使用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

如果要避免使用QueryDef，请尝试错误处理程序代码：

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

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

1 个答案: