Excel 2013中使用范围超出行65536时出现的问题

问题描述:

我试图在Excel 2013工作簿中的命名范围上执行ADODB查询。Excel 2013中使用范围超出行65536时出现的问题

我的代码如下:

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 

如果范围HighRange超出65536行(例如A65527:B65537)我得到一个错误信息 enter image description here

如果我删除了足够的行掉落范围在65536行之下,代码有效。

如果我强制工作簿为只读(并确保没有人打开非只读版本),该代码也可以使用。

这是我做错了什么,或者这是Excel 2013中的错误?

(问题存在于32位和64位版本。也存在在Excel 2016年)

+1

我猜测你发现MSoft的一个实例忘记在他们的MS Access数据库引擎代码中将'int'换成'long' ...听起来像是一个bug。试试XL2016? –

+0

不幸的是,这是一个工作情况,所以我们只是去Excel 2013.(我不认为我们在Excel 2010中有问题。) – YowE3K

+3

http://forum.chandoo.org/threads/excel-recordset-only-返回-65536-rows-if-you-try-to-pull-data-from-a-range.12492/ –

我一直没能找到一个实际的答案,我的问题,所以最好变通我可以想出的是创建一个额外的工作簿,将我的范围复制到工作簿中的工作表(从单元格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 

我还是喜欢一个更强大的解决这个问题,所以很愿意别人拿出另一个答案。