这是一个成功粘贴记录集的子例程。
请注意,它粘贴到的范围与通过 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
使用该示例作为模型,我会为您的代码尝试这样的事情:
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