2016-07-29 39 views
4

Excel 2013ブックの名前付き範囲でADODBクエリを実行しようとしています。行65536を超えて範囲を使用するExcel 2013での問題

次のように私のコードは次のとおりです。

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ビット版の両方に存在する。また、エクセル2016に存在する)、

+1

私は、MSoftのインスタンスがMS Accessデータベースのエンジンコードで 'int'を' long'に変更するのを忘れてしまったと推測します...バグのようなものです。 XL2016で試してみませんか? –

+0

残念ながら、それは仕事の状況なので、Excel 2013に行っています。(Excel 2010では問題はなかったと思います) – YowE3K

+3

http://forum.chandoo.org/threads/excel-recordset-only-戻り値-65536-rows-if-you-try-to-a-range-from-range.12492/ –

答えて

1

私は私の問題への実際の答えを見つけることができていない仕事周りの最高そう私は、余分なワークブックを作成し、そのワークブック(セルA1から始まる)のシートに範囲をコピーし、そのワークブックを保存してから、そのワークブック/ワークシートをクエリのソースとして使用することができます。

(元は、既存のワークブックで一時的なワークブックを作成するだけでなく、一時的なワークブックを作成せずに済むと思っていましたが、ユーザーが2つのExcelインスタンスをアクティブにすると問題が発生します。 2番目のインスタンスでマクロを実行しているにもかかわらず、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 

は、私はまだこの問題に、より堅牢なソリューションを好むだろう、そう他の誰かが別の答えを思い付くのが大好きです。

関連する問題