faster export to excel?

  • Thread starter Thread starter Jey
  • Start date Start date
J

Jey

I'm exporting an access recordset to excel. My questions are:
1) Is there a faster way? A large recordset can take over 1/2 an hour!
2) Some of my recordsets will have over 100,000 records. What's the best
(most efficient) way to set up a loop to separate it into multiple worksheets
with no more than 65,000 records per worksheet?

My code so far is:
Dim strSQL As String
Dim DB As Database
Set DB = CurrentDb()
Dim RS As Recordset
Dim objXL As Excel.Application
Dim objWS As Excel.worksheet
Dim fld As Field
Dim intCol As Integer
Dim intRow As Integer

strSQL = "SELECT ...blah blah blah..."
Set RS = DB.OpenRecordset(strSQL) 'create recordset
'create and name worksheet
Set objWS = objXL.Worksheets.Add 'opens a new sheet in the workbook
objWS.Name = "BLAH" 'names the new sheet
'copy to worksheet
'first the field names
For intCol = 0 To RS.Fields.Count - 1
Set fld = RS.Fields(intCol)
objWS.Cells(1, intCol + 1) = fld.Name
Next intCol
'now the actual data
intRow = 2
Do Until RS.EOF
For intCol = 0 To RS.Fields.Count - 1
objWS.Cells(intRow, intCol + 1) = RS.Fields(intCol).Value
Next intCol
RS.MoveNext
intRow = intRow + 1
Loop

Thanks in advance for any advice!
 
The answer to the first question is to look at the CopyFromRecordset
property of the Range object in Excel. It's infinitely faster than
assigning field values one-by-one.

That might get a little tricky when you get to your second question,
however, as I don't believe you can use CopyFromRecordset to copy only part
of a recordset...it's all or nothing. You might want to look at splitting
the recordset up at the source by using a SELECT TOP query or filtering the
recordset in whatever way is logical for your app.



Rob
 
Thanks, that goes much faster now!
I haven't figured out how to split up the recordset yet though. One idea I
had was to try to set bookmarks every 65000 rows, then somehow count them up
to see how many worksheets I need to create, and start each worksheet at the
next bookmark... or something like that. So far no luck in getting it to
work. There must be a better way?
 
It's SERIOUSLY ugly, but if all else fails, export the recordset to a text
file, split the text file into as many parts as you need, then open the new
files in Excel. Really a last-ditch method, though.


Rob
 
After much trial and error, I made the happy discovery that the
CopyFromRecodset will leave you sitting at the next record in the recordset
after copying as much as the destination sheet will hold... leading to the
the following code which will create as many pages as needed to export all of
the records in the recordset (assume you're starting with a recordset 'RS'
etc. as in my first post):

intSheetNumber = 1

Do Until RS.EOF
'adds a new sheet and name it
Set objWS = objXL.Worksheets.Add
strSheetName = "GPS" & intSheetNumber
objWS.Name = strSheetName

'add the field names
For intCol = 0 To RS.Fields.Count - 1
Set fld = RS.Fields(intCol)
objWS.Cells(1, intCol + 1) = fld.Name
Next intCol

'this will copy the data into the current page
'luckily, it only copies however much can fit on the page, and then sits
at the next record!
objWS.Range(objWS.Cells(1, 1), objWS.Cells(1,
RS.Fields.Count)).Font.Bold = True 'this just makes the field names bold!
objWS.Range("A2").CopyFromRecordset RS

'set the next sheet number
intSheetNumber = intSheetNumber + 1
Loop


Thanks again for the help!

Jey
 
Well isn't THAT interesting! I wasn't aware of that. That's really
special. Thanks for that!


Rob
 
Just for closure on this, here the final version of my procedure to export a
recordset to excel. Works like a charm!


Public Sub ExportToWorksheet(objXL As Excel.Application, RS As Recordset,
strName As String)

'takes an open Excel workbook, a populated recordset, and a name stub
'exports the recordset to one or more new (named and numbered) worksheets


On Error GoTo Err_Handler

Dim intSheetNumber As Integer
Dim objWS As Excel.worksheet
Dim strSheetName As String
Dim fld As Field
Dim intCol As Integer


RS.MoveLast

If RS.RecordCount > 65000 Then

RS.MoveFirst
intSheetNumber = 1

Do Until RS.EOF
'adds a new sheet and name it
Set objWS = objXL.Worksheets.Add
strSheetName = strName & intSheetNumber
objWS.Name = strSheetName

'add the field names
For intCol = 0 To RS.Fields.Count - 1
Set fld = RS.Fields(intCol)
objWS.Cells(1, intCol + 1) = fld.Name
Next intCol

'this will copy the data into the current page
'luckily, it only copies however much can fit on the page, and then
sits at the next record!
objWS.Range(objWS.Cells(1, 1), objWS.Cells(1,
RS.Fields.Count)).Font.Bold = True
objWS.Range("A2").CopyFromRecordset RS

'set the next sheet number
intSheetNumber = intSheetNumber + 1
Loop

Else
RS.MoveFirst

'create and name worksheet
Set objWS = objXL.Worksheets.Add
objWS.Name = strName

'copy to worksheet
'first the field names
For intCol = 0 To RS.Fields.Count - 1
Set fld = RS.Fields(intCol)
objWS.Cells(1, intCol + 1) = fld.Name
Next intCol
'now the actual data
objWS.Range(objWS.Cells(1, 1), objWS.Cells(1,
RS.Fields.Count)).Font.Bold = True
objWS.Range("A2").CopyFromRecordset RS
End If


Err_Handler_Exit:
Exit Sub

Err_Handler:
MsgBox Err.Number & " - " & Err.Description & " - Sub ExportToWorksheet()"
Resume Err_Handler_Exit

End Sub
 
Hi , thanks for the easy and fast way to export to excel .
I am trying to export using the same concept, however for one of my record set I am getting an exception
System.Runtime.InteropServices.COMException(0x80004005):Unspecified error
at System.RuntimeType.ForwardCallToInvokeMemeber(String memberName,BindingFlags Flags,object target,Int32[] aWarraper Types,MessageData& msgData)
at Microsoft.Office.Interop.Excel.Range.CopyFromRecodset(Object Data,object MaxRow,Object MaxColumn)
 
Back
Top