无法读取数据库或只读对象

Question

我正在尝试使用 VBA 和 ADO 选项从另一个文件查询 Excel 文件。当我运行这段代码时，它抛出错误 "Cannot updata, Database or object Read only":

Public Function fnExecuteXlQuery _
    (ByVal strPath As String,  _
    ByVal strQuery As String) As ADODB.Recordset

Dim rs As ADODB.Recordset
Dim conStr As String

On Error GoTo ErrorHandler

conStr = "Provider=Microsoft.Jet.OLEDB.4.0; " _ 
      & "Data Source=" & strPath & "; Extended Properties=Excel 8.0"

Set rs = New ADODB.Recordset
rs.Open strQuery, conStr, adOpenDynamic

Set fnExecuteXlQuery = rs

Exit Function
ErrorHandler:
Set fnExecuteXlQuery = Nothing
fnDisplayError Error(Err) & "Unable to fetch data from DTS...", ERROR_TYPE_ERROR
End Function

“strPath”是源 Excel 文件，“strquery”具有以下 SQL代码：

Select [Activity],[Name],[Date],[Hours Spent] 
from [Time sheet$] 
where [Activity] = 'Billable Activities' 
Order by Name,date

Answer 1

也许评论中所说的所有内容都需要再写一遍，以确保您确实得到了正确的解决方案：

Option Explicit

Public Sub ConnectionToExcel()
Dim rstResult As ADODB.Recordset
Dim strConnectin As String
Dim strPath As String
Dim strSQL As String

strPath = "C:\Data\YourFile.xlsm"

strConnectin = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
    "Data Source='" & strPath & "';Extended Properties=""Excel 12.0 XML;HDR=YES;IMEX=1"" "
Debug.Print strConnection

strSQL = "SELECT * FROM [Time sheet$] "

Set rstResult = New ADODB.Recordset
rstResult.Open strSQL, strConnectin, adOpenForwardOnly, adLockReadOnly, adCmdText

Sheet1.Range("A1").CopyFromRecordset rstResult

End Sub

请注意，我一步一个脚印：(1) 我使用的是 sub 而不是函数。 (2) select 已经过简化，只是为了测试连接，以后可以对其进行扩展。 (3) 直接把结果写回第一个sheet。 (4) 进一步限制记录集为adOpenForwardOnly和adLockReadOnly.

此外，请记住上面的代码使用了早期绑定，因此需要您在 Tools --> References... 中设置对 Microsoft ActiveX Data Objects 2.8 Library（或更高版本）的引用。

无法读取数据库或只读对象

Cannot read Database or object read only

excel

vba

ado

jet