我正在尝试对 Excel 2013 工作簿中的命名范围执行 ADODB 查询。
我的代码如下:
Option Explicit
Sub SQL_Extract()
Dim objConnection As ADODB.Connection
Dim objRecordset As ADODB.Recordset
Set objConnection = CreateObject("ADODB.Connection") ' dataset query object
Set objRecordset = CreateObject("ADODB.Recordset") ' new dataset created by the query
objConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
objConnection.Open
objRecordset.Open "SELECT * FROM [HighRange]", objConnection, adOpenStatic, adLockOptimistic, adCmdText
If Not objRecordset.EOF Then
ActiveSheet.Cells(1, 1).CopyFromRecordset objRecordset
End If
objRecordset.Close
objConnection.Close
End Sub
If the range HighRange
extends beyond row 65536 (e.g. A65527:B65537) I get an error message
如果我删除足够多的行以将范围降至第 65536 行以下,则代码可以正常工作。
如果我强制工作簿为只读(并确保其他人没有打开非只读版本),该代码也可以工作。
这是我做错了什么,还是 Excel 2013 中的错误?
(32 位和 64 位版本均存在问题。Excel 2016 中也存在。)
我无法找到问题的实际答案,因此我能想到的最佳解决方法是创建一个额外的工作簿,将我的范围复制到该工作簿中的工作表(从单元格 A1 开始),保存该工作簿,然后使用该工作簿/工作表作为查询的源。
(我原本以为我可以只在现有工作簿中创建一个临时工作表,即不创建临时工作簿,但如果用户有两个活动的 Excel 实例,则会出现问题 - Connection.Open 事件在以下位置重新打开工作簿Excel 的第一个实例,即使我们在第二个实例中运行宏,因此重新打开的工作簿中没有虚拟工作表。而且我不想使用以下命令保存现有工作簿的副本里面有一个虚拟表。)
Sub SQL_Extract_Fudged()
Dim objConnection As ADODB.Connection
Dim objRecordset As ADODB.Recordset
Dim wsOrig As Worksheet
Dim wbTemp As Workbook
Dim wbTempName As String
Dim wsTemp As Worksheet
Set wsOrig = ActiveSheet
'Generate a filename for the temporary workbook
wbTempName = Environ$("TEMP") & "\TempADODBFudge_" & Format(Now(), "yyyymmdd_hhmmss") & ".xlsx"
'Create temporary workbook
Set wbTemp = Workbooks.Add
'Use first sheet as the place for the temporary copy of the range we want to use
Set wsTemp = wbTemp.Worksheets(1)
wsTemp.Name = "TempADODBFudge"
'Copy the query range to the temporary worksheet
wsOrig.Range("HighRange").Copy Destination:=wsTemp.Range("A1")
'Save and close the temporary workbook
wbTemp.SaveAs wbTempName
wbTemp.Close False
'Get rid of references to the temporary workbook
Set wsTemp = Nothing
Set wbTemp = Nothing
'Create connection and recordset objects
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
'Create the connection string pointing to the temporary workbook
objConnection.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & wbTempName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
objConnection.Open
'Perform the query against the entire temporary worksheet
objRecordset.Open "SELECT * FROM [TempADODBFudge$]", objConnection, adOpenStatic, adLockOptimistic, adCmdText
'Copy output (for this example I am just copying back to the original sheet)
If Not objRecordset.EOF Then
wsOrig.Cells(1, 1).CopyFromRecordset objRecordset
End If
'Close connections
objRecordset.Close
objConnection.Close
'Get rid of temporary workbook
On Error Resume Next
Kill wbTempName
On Error GoTo 0
End Sub
我仍然希望有一个更强大的解决方案来解决这个问题,所以希望其他人能提出另一个答案。
本文内容由网友自发贡献,版权归原作者所有,本站不承担相应法律责任。如您发现有涉嫌抄袭侵权的内容,请联系:hwhale#tublm.com(使用前将#替换为@)