SLOOOW VBA data transfer from Access to Excel sheet

hdomino · #1 (**permalink**) 06-11-09, 11:05

Hello everybody,

I have a pretty large database (~50.000 rows x 10 cols). The data is saved as a table with Access. A query is called, which sorts the data by date (1st column). This query is called from a Access-VBA routine and the VBA code writes all data into an Excel sheet. This process takes ~1 hour to complete

.

I'm desparately trying to improve the performance here, and at least cut the processing time by 50%. Are there ways to make the following lines faster?

.
.
set rstVal = qdf.OpenRecordset(dbOpenSnapShot)
.
.
For i = 0 To numRows
set rngCurrent = rngABeg.Offset(i, 0)
For j = 0 to rstVal.Fields.Count - 1
rngCurrent.Value = rstVal.Fields(j).Value
Set rngCurrent = rngCurrent.Offset(0, 1)
Next
rstVal.MoveNext
Next
.
.

Thanks a lot in advance,
Heiko

Ax238 · #2 (**permalink**) 06-11-09, 12:09

There are a number of ways to do this:

You can use the TransferSpreadsheet method:

Code:

DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "theQuery", "C:\Report.xls", True

You can execute a recordset into a spreadsheet:

Code:

strQuery = "SELECT * INTO [Excel 8.0;DATABASE=C:\Report.xls].[Data] FROM theQuery"
cnn.Execute strQuery, RecordsAffected, adExecuteNoRecords

You can use the CopyFromRecordset method:

Code:

For iCols = 0 to rs.Fields.Count - 1
    ws.Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
ws.Range(ws.Cells(1, 1),  _
    ws.Cells(1, rs.Fields.Count)).Font.Bold = True
ws.Range("A2").CopyFromRecordset rs

The above methods copy column headers and then the recordset data into Excel. It all depends on whether you need to perform any actions on the data after transferring it to Excel or if it is just to export it and leave it as is.

Regards,

Ax

hdomino · #3 (**permalink**) 06-12-09, 04:30

Hello Ax,

the last suggestion was the solution. Copying is now nearly instantaneous.

Thanks,
hdomino

Ax238 · #4 (**permalink**) 06-12-09, 09:21

Excellent! Glad it worked out for you.

Cheers,

Ax

LordOne · #5 (**permalink**) 04-08-10, 02:48

hi,

I'm very beginner in this field and I want to put 4 access tables in one excel sheet one under another with a line between them and I don't now how...
if anyone can please help me please ...

with

Code:

ws.Range("A2").CopyFromRecordset rs

I think that I can't because I have to specify something in A2 - range and I want to copyfrom recordset first table, find last use cell on A column, then move to another down cell copyfromrecordset the second table and so on...

now I have this code that i don't know how ...

Code:

 Set rs = conn.Execute("accesstable3", , adCmdTable)
   'Transfer the 3th data table to Excel
   oSheet.Range("A65536").End(xlUp).Select
   ActiveCell.Offset(1, 0).Activate
   oSheet.Range("A").CopyFromRecordset rs   'here is my problem with a parameter
   
   Set rs = conn.Execute("accesstable4", , adCmdTable)
   oSheet.Range("A65536").End(xlUp).Select
   ActiveCell.Offset(1, 0).Activate
   'Transfer the 4th data table to Excel  
   oSheet.Range("A").CopyFromRecordset rs  'here is my problem with a parameter

Colin Legg · #6 (**permalink**) 04-08-10, 07:41

Hi,

Don't select sheets or cells.
The ActiveCell property isn't qualified which will mean that (at best) an Excel process will be left running.
Range("A") is invalid because "A" is not a string that represents a valid range address.

This code:

Code:

Set rs = conn.Execute("accesstable4", , adCmdTable)
   oSheet.Range("A65536").End(xlUp).Select
   ActiveCell.Offset(1, 0).Activate
   'Transfer the 4th data table to Excel  
   oSheet.Range("A").CopyFromRecordset rs  'here is my problem with a parameter

Can be condensed to:

Code:

Set rs = conn.Execute("accesstable4", , adCmdTable)
oSheet.Range("A65536").End(xlUp).Offset(1, 0).CopyFromRecordset rs

Hope that helps...

LordOne · #7 (**permalink**) 04-08-10, 08:19

UPDATE

this code works perfect !

Code:

 
 Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   
   Set oExcel = CreateObject("Excel.Application")
   Set oBook = oExcel.Workbooks.Add     'Create a new workbook
   Set oSheet = oBook.Sheets.Add        'Create a new worksheet
   
   
'SHEET-ul 1 PRODUSE C.D.
Set oSheet = oBook.Worksheets(1)
   
   oSheet.Name = "Produse CD" 'Rename the sheet
   
   
   
   Set rs = conn.Execute("captabelproduse", , adCmdTable)
   Set oSheet = oBook.Worksheets(1)
   oSheet.Range("A1").CopyFromRecordset rs
   
Set rs = conn.Execute("cegalatiprodcd", , adCmdTable)
    oSheet.Range("A65536").End(xlUp).Select
    ActiveCell.Offset(1, 0).Activate
        oExcel.ActiveCell.CopyFromRecordset rs
        
Set rs = conn.Execute("segalatiprodcd", , adCmdTable)
    oSheet.Range("A65536").End(xlUp).Select
    ActiveCell.Offset(2, 0).Activate
        oExcel.ActiveCell.CopyFromRecordset rs
        
Set rs = conn.Execute("cebuzauprodcd", , adCmdTable)
    oSheet.Range("A65536").End(xlUp).Select
    ActiveCell.Offset(2, 0).Activate
         oExcel.ActiveCell.CopyFromRecordset rs

Set rs = conn.Execute("ceadjudprodcd", , adCmdTable)
    oSheet.Range("A65536").End(xlUp).Select
    ActiveCell.Offset(2, 0).Activate
         oExcel.ActiveCell.CopyFromRecordset rs

   oSheet.Columns("G:G").NumberFormat = "dd.mm.yyyy"

but now I want to continue this code to make same thing on sheet 2,
and I have an error
"Select method of Range class failed"
when I do this code witch is identical like first one only I've changed the sheet no.

Code:

 
'SHEET-ul 2 PRODUSE Central
Set oSheet = oBook.Worksheets(2)
 oSheet.Name = "Produse Central" 'Rename the sheet

Set rs = conn.Execute("captabelproduse", , adCmdTable)
    oSheet.Range("A1").CopyFromRecordset rs

Set rs = conn.Execute("ceadjudprodcd", , adCmdTable)
    oSheet.Range("A2").CopyFromRecordset rs
    

Set rs = conn.Execute("cebuzauprodcd", , adCmdTable)
    oSheet.Range("A65536").End(xlUp).Select
    ActiveCell.Offset(2, 0).Activate
         oExcel.ActiveCell.CopyFromRecordset rs

Can anyone can explain or give me a solution please ?

Colin Legg · #8 (**permalink**) 04-08-10, 08:24

Hi,

I already addressed that in my previous reply. You can't select a cell unless it's on the active sheet. However, you don't need to select any cells at all as demonstrated in my example.

For reference, this is cross posted at XVBT.
http://www.xtremevbtalk.com/showthread.php?t=315026

LordOne · #9 (**permalink**) 04-08-10, 08:26

and how can I make a sheet 2 active ?
sorry I'm very newbie ...

Colin Legg · #10 (**permalink**) 04-08-10, 08:33

Hi,

Quote:

sorry I'm very newbie ...

It's okay, I was probably going too fast. I'll try to explain more thoroughly:

If you try to select a cell on Sheet2 then you would have to make Sheet2 active because you can only select cells on the active sheet. However, there's no need to make sheet2 active because you can avoid selecting cells altogether. Here's the code I posted:

Code:

Set rs = conn.Execute("accesstable4", , adCmdTable)
oSheet.Range("A65536").End(xlUp).Offset(1, 0).CopyFromRecordset rs

I haven't activated any sheets in this code and I don't need to because I haven't selected any cells either.

Does that make better sense now?

LordOne · #11 (**permalink**) 04-08-10, 08:37

Yes it makes sense but,

I need to export 16 access tables in 4 excel sheets - 4 access tables each excel sheet

and I don't understand how is that possible without activating sheet 2 before start copying on it..

LordOne · #12 (**permalink**) 04-08-10, 08:46

YOU ARE THE MAN !!! -

IT VERY WORKS !!!!

THANK YOU VERY MUCH !!!!

have a wonderful day

Internet Services

Web Development

Digital Marketing

Consumer Tech