View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Fredrik Wahlgren Fredrik Wahlgren is offline
external usenet poster
 
Posts: 339
Default 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