不能读取数据库或对象只读

Question

我正在尝试使用VBA和ADO选项从另一个文件查询Excel文件。当我运行这段代码时，它抛出错误"无法更新数据，数据库或对象只读":

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:DataYourFile.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)把结果写回第一张纸。(4)进一步限制记录集仅为adOpenForwardOnly和adLockReadOnly。

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