CopyFromRecordset copies & pastes only first one row even though multiple records are present in Excel

问题

I have an Excel sheet containing table like data

strSQL = "SELECT S.FIELD_NAME1,S.FIELD_NAME2,S.FIELD_NAME3 from [SourceData$A1:IV6] S"

Dim cn as ADODB.Connection
Dim rs as ADODB.Recordset
cn.Open strCon
Set rs = CmdSqlData.Execute()
Worksheets("SourceData").Cells.ClearContent
Worksheets("AnswerData").Cells(2, 1).CopyFromRecordset rs

Results :
Only first row and other records are ignored.

I have tried below query .,

strSQL = "SELECT COUNT(*) from [SourceData$A1:IV6] S"

Which gives 5 as result.

Please let me know why other records not copied into recordset?

回答1:

Here's a subroutine that successfully pastes a recordset.

Note that the range it pastes to is the same size of the recordset via the intMaxRow and intMaxCol variables:

Sub sCopyFromRS()
'Send records to the first
'sheet in a new workbook
'
Dim rs As Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
  Set rs = CurrentDb.OpenRecordset("Customers", _
                    dbOpenSnapshot)
  intMaxCol = rs.Fields.Count
  If rs.RecordCount > 0 Then
    rs.MoveLast:    rs.MoveFirst
    intMaxRow = rs.RecordCount
    Set objXL = New Excel.Application
    With objXL
      .Visible = True
      Set objWkb = .Workbooks.Add
      Set objSht = objWkb.Worksheets(1)
      With objSht
        .Range(.Cells(1, 1), .Cells(intMaxRow, _
            intMaxCol)).CopyFromRecordset rs
      End With
    End With
  End If
End Sub

Using that example as a model, I'd try somehting like this for your code:

strSQL = "SELECT S.FIELD_NAME1,S.FIELD_NAME2,S.FIELD_NAME3 from [SourceData$A1:IV6] S"

Dim cn as ADODB.Connection
Dim rs as ADODB.Recordset
Dim intMaxCol as Integer
Dim intMaxRow as Integer

cn.Open strCon
Set rs = CmdSqlData.Execute()
intMaxCol = rs.Fields.Count
'- MoveLast/First to get an accurate RecordCount
rs.MoveLast 
rs.MoveFirst

If rs.RecordCount > 0 then
    '-thought you could put the MoveLast/First here but maybe not.
    intMaxRow = rs.RecordCount
    With Worksheets("AnswerData")
        .Range(.Cells(2,1),.Cells(intMaxRow+1,intMaxColumn)).CopyFromRecordset rs
    End With
End If

回答2:

This answer depends upon your ODBC database driver available in Excel.

Due to my corp env, I am forced to use a very old Oracle ODBC driver. In my case, Recordset.RecordCount is always -1. By default, Recordset.MoveLast and Recordset.MoveFirst is not supported. Like the original question, calls to Excel.Range.CopyFromRecordset(Recordset) also only write a single row.

You may need to configure your ADODB.Recordset differently. Try this code:

Dim dbConn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rng As Excel.Range
Dim rowCount As Long

' TODO: Init your dbConn here.
' TODO: Init your rng here.

Set rs = New ADODB.Recordset
' http://www.w3schools.com/ado/prop_rs_cursortype.asp
rs.CursorType = ADODB.CursorTypeEnum.adOpenKeyset
rs.Open sql, dbConn
rowCount = rng.CopyFromRecordset(rs)

For my driver, this fixes the issue. However, your mileage may vary.

You can read more about ADO cursor types here.

回答3:

I meet the same problem.

Only Replace

set rst = conn.execute("SELECT * FROM SOMETABLE;")

with

call rst.open("SELECT * FROM SOMETABLE;", conn)

Then the problem is sovled

But， I don't know why.

来源：https://stackoverflow.com/questions/11426103/copyfromrecordset-copies-pastes-only-first-one-row-even-though-multiple-record

标签

excel

vba

excel-vba

adodb