vba 即使 Excel 中存在多条记录，CopyFromRecordset 也仅复制和粘贴第一行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11426103/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
CopyFromRecordset copies & pastes only first one row even though multiple records are present in Excel
提问by logan
I have an Excel sheet containing table like data
我有一个 Excel 工作表，其中包含类似数据的表格
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 5as result.
这给出5了结果。
Please let me know why other records not copied into recordset?
请让我知道为什么其他记录没有复制到记录集中？
采纳答案by danielpiestrak
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:
请注意，它通过 intMaxRow 和 intMaxCol 变量粘贴到的范围与记录集的大小相同：
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
回答by kevinarpe
This answer depends upon your ODBC database driver available in Excel.
此答案取决于 Excel 中可用的 ODBC 数据库驱动程序。
Due to my corp env, I am forced to use a very old Oracle ODBC driver. In my case, Recordset.RecordCountis always -1. By default, Recordset.MoveLastand Recordset.MoveFirstis not supported. Like the original question, calls to Excel.Range.CopyFromRecordset(Recordset)also only write a single row.
由于我的公司环境，我被迫使用非常旧的 Oracle ODBC 驱动程序。在我的情况下，Recordset.RecordCount总是-1. 默认情况下，Recordset.MoveLast并且Recordset.MoveFirst不支持。像原来的问题一样，调用Excel.Range.CopyFromRecordset(Recordset)也只写一行。
You may need to configure your ADODB.Recordsetdifferently. Try this code:
您可能需要进行ADODB.Recordset不同的配置。试试这个代码：
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.
对于我的驱动程序，这解决了问题。但是，您的里程可能会有所不同。
回答by Zhang Hansen
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.
但是，我不知道为什么。
