Excel VBA - CopyFromRecordset (ADO) Problems with 107000 records
"Philip" wrote in message
...
Hi,
I have an ADO recordset with 107000+ records (loaded from text file using
schema.ini file and ADBC Text Driver).
I need to get this data into Excel sheets, first, copy 65535 (1st
row=column
heads), then keep copying 65535 onto new worksheets (1st row=column heads)
until there are no records left.
There could be many hundreds of thousands of records, perhaps up to 700000
... so I can't just hard code it to do 2 or 3 Copies
Unfortunately on the second time I use the CopyFromRecordset method it
fails, and for some reason the recordset 'AbsolutePosition' property is
set
to -3, even though I can get the recordcount...
Here is my code:
CODE
Dim oConn As New ADODB.Connection
Dim oRec As New ADODB.Recordset
Dim iNoRec As Long
Dim iCount As Long
Dim iCurrRec As Long
Dim iNoSheets As Integer, iSheet As Integer, iFlds As Integer
Dim sQry As String, sColumnHeads As String
oConn.Open "DBQ=G:\EVERYONE\Ad\IPS
Group\ddi\;DefaultDir=G:\EVERYONE\Ad\IPS
Group\ddi\;Driver={Microsoft Text Driver (*.txt;
*.csv)};DriverId=27;Extensions=asc,csv,tab,txt;FIL =text;MaxBufferSize=2048;M
axScanRows=25;PageTimeout=5;SafeTransactions=0;Thr eads=3;UID=admin;UserCommi
tSync=Yes;"
sQry = "select FUNDCODE, CLIENT_SPARE, FIN_STMT_CURRCY, ACCOUNT,
SUBACCOUNT,
LOCAL_CURRENCY, BASIS," _
& "CD_ACTIVITY_SIGN + CD_ACTIVITY as CD_ACTIVITY1, CY_ACTIVITY_SIGN +
CY_ACTIVITY as CY_ACTIVITY1, PROC_RATIO, DATE_ADDED," _
& "TIME_ADDED, ADD_PROGRAM_ID, DATE_UPDATED, TIME_UPDATED,
UPD_PROGRAM_ID from l902glm#txt"
With oRec
.CursorLocation = adUseClient
.Open sQry, oConn
Sheets("Sheet1").Name = "l902glm_1"
For iFlds = 0 To .Fields.Count - 1
Sheets("l902glm_1").Cells(1, iFlds + 1).Value =
..Fields(iFlds).Name
Next
End With
iCurrRec = 1
iSheet = 1
iNoRec = oRec.RecordCount
oRec.MoveFirst
Sheets("l902glm_" & iSheet).Select
Range("A2").Select
Do While Not iCurrRec iNoRec
oRec.Move iCurrRec - 1
ActiveCell.CopyFromRecordset oRec, 65536
If oRec.RecordCount = iCurrRec Then
Sheets.Add After:=Sheets("l902glm_" & iSheet)
iSheet = iSheet + 1
Sheets(Sheets.Count).Name = "l902glm_" & iSheet
iCurrRec = iCurrRec + 65535
Sheets("l902glm_" & IIf(iSheet 1, iSheet - 1, 1)).Activate
' copy column/field names ... to next sheet
Sheets("l902glm_" & IIf(iSheet 1, iSheet - 1, 1)).Range(Cells(1,
1), Cells(1, oRec.Fields.Count)).Copy Destination:=Sheets("l902glm_" &
iSheet).Range("A1")
Sheets("l902glm_" & iSheet).Select
Range("A2").Select
End If
Loop
'MsgBox oRec.RecordCount
'oRec.Move 65537
oRec.Close
oConn.Close
END
I'd be grtateful for any help, ideas, improvements, solutions, or even
some
sympathy...
thanks
Philip
Are you sure you need every darn record? Wouldn't it make sense to use the
WHERE clause to limit the records you get?
/Fredrik
|