2016-07-29 58 views
4

我試圖在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/ –

回答

1

我一直沒能找到一個實際的答案,我的問題,所以最好變通我可以想出的是創建一個額外的工作簿,將我的範圍複製到工作簿中的工作表(從單元格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 

我還是喜歡一個更強大的解決這個問題,所以很願意別人拿出另一個答案。