loop adodb recordset export to excel works but very slow.

S

Steve'o

Server = SQL Server 2000 SP4
Client = Access 2000 SP3 (Windows 2000 SP4)

Im using vba in Access to loop through adodb recordset (simply select * from
my_sql2000_view) and output the result to Excel 2000.

The problem is the time, it works, but takes way too long, can someone
explain what I may be doing wrong please?

Data = 2000 rows and 12 columns varchar(100) and 2 columns money

Opening sql2000 view in Access = <2 seconds
ODBC link from within Excel = <10 seconds
docmd.outputto acoutputserverview, "my_view", acFormatXLS,
"c:\temp\export.xls" = <10seconds
Loop through ADODB in Access and put into Excel = 4minutes!!

If possible, I'd like to use the adodb method below because I can format the
spreadsheet and have multiple sheets.

Many thanks for any suggestions!


Private Sub lblExcel_Click()
On Error GoTo ERR_ERROR

Dim strYear As String
Dim adoRST As New ADODB.Recordset, adoCON As New ADODB.Connection,
strSQL As String
Dim XL As Excel.Application

strYear = Nz(Form_FRM_MAIN_MENU.cmboYear, 0)

strSQL = "select * from vw_sys_post_totals_02 where ph_year = '" &
strYear & "'"

Set adoCON = CurrentProject.Connection

adoRST.Open strSQL, adoCON

Set XL = New Excel.Application

XL.Workbooks.Add
XL.Worksheets.Add
XL.ActiveWorkbook.ActiveSheet.Name = "Audit"
XL.Worksheets.Add
XL.ActiveWorkbook.ActiveSheet.Name = "Post Details"

XL.Sheets("Post Details").Select
XL.Range("A1").Select

XL.ActiveCell = "YEAR"
XL.ActiveCell.Offset(0, 1) = "SORT"
XL.ActiveCell.Offset(0, 2) = "POST"
XL.ActiveCell.Offset(0, 3) = "POST TITLE"
XL.ActiveCell.Offset(0, 4) = "EXT FUND"
XL.ActiveCell.Offset(0, 5) = "STATUS"
XL.ActiveCell.Offset(0, 6) = "DIRECTORATE"
XL.ActiveCell.Offset(0, 7) = "SERVICE UNIT"
XL.ActiveCell.Offset(0, 8) = "SECTION"
XL.ActiveCell.Offset(0, 9) = "SUB SECTION"
XL.ActiveCell.Offset(0, 10) = "NAME"
XL.ActiveCell.Offset(0, 11) = "COST CENTRE"
XL.ActiveCell.Offset(0, 12) = "COST CENTRE DESCRIPTION"
XL.ActiveCell.Offset(0, 13) = "PERCENTAGE"
XL.ActiveCell.Offset(0, 14) = "PERCENTAGE TOTAL"

XL.Range("A1:O1").Select
XL.Selection.Font.Bold = True
XL.Selection.HorizontalAlignment = xlCenter
XL.Selection.Interior.ColorIndex = 15

XL.Columns("A:C").ColumnWidth = 6
XL.Columns("D:D").ColumnWidth = 32
XL.Columns("E:F").ColumnWidth = 9
XL.Columns("G:G").ColumnWidth = 13
XL.Columns("H:K").ColumnWidth = 28
XL.Columns("L:L").ColumnWidth = 13
XL.Columns("M:M").ColumnWidth = 31
XL.Columns("N:N").ColumnWidth = 12
XL.Columns("A:C").ColumnWidth = 6
XL.Columns("O:O").ColumnWidth = 18

XL.Columns("E:G").HorizontalAlignment = xlCenter
XL.Columns("L:L").HorizontalAlignment = xlCenter

XL.Columns("A:M").NumberFormat = "@"
XL.Columns("N:O").NumberFormat = "#,##0.00[BLACK];(#,##0.00)[RED]"

XL.Range("A2").Select


Do While Not adoRST.EOF
XL.ActiveCell = adoRST.Fields("ph_year")
XL.ActiveCell.Offset(0, 1) = adoRST.Fields("ph_sort")
XL.ActiveCell.Offset(0, 2) = adoRST.Fields("ph_post_no")
XL.ActiveCell.Offset(0, 3) = adoRST.Fields("ph_post_title")
XL.ActiveCell.Offset(0, 4) = adoRST.Fields("ph_externally_funded")
XL.ActiveCell.Offset(0, 5) = adoRST.Fields("ph_status")
XL.ActiveCell.Offset(0, 6) = adoRST.Fields("ph_directorate")
XL.ActiveCell.Offset(0, 7) = adoRST.Fields("ph_service_unit")
XL.ActiveCell.Offset(0, 8) = adoRST.Fields("ph_section")
XL.ActiveCell.Offset(0, 9) = adoRST.Fields("ph_sub_section")
XL.ActiveCell.Offset(0, 10) = adoRST.Fields("ph_name")
XL.ActiveCell.Offset(0, 11) = adoRST.Fields("pd_cost_centre")
XL.ActiveCell.Offset(0, 12) = adoRST.Fields("cc_description")
XL.ActiveCell.Offset(0, 13) = adoRST.Fields("pd_percentage")
XL.ActiveCell.Offset(0, 14) = adoRST.Fields("pt_percentage_total")
XL.ActiveCell.Offset(1, 0).Select
adoRST.MoveNext
Loop

XL.Range("A2").Select

adoRST.Close

Set adoRST = Nothing
Set adoCON = Nothing

XL.Visible = True

Exit Sub
ERR_ERROR:
Call Errors
End Sub


Many thanks!
 
S

Steve'o

After a couple more hours googling, its solved. YAY for google, without it I
wouldn't have a job! :)

The do while not adorst.eof loop took 4 minutes, replacing it with
copyFromRecordset has brought the time down to 9 seconds!!

New Code:
Private Sub lblExport_Click()
On Error GoTo ERR_ERROR
Dim strYear As String
Dim adoRST As New ADODB.Recordset, adoCON As New ADODB.Connection,
strSQL As String
Dim XL As Excel.Application

strYear = Nz(Form_FRM_MAIN_MENU.cmboYear, 0)

strSQL = "select ph_year, " & _
"ph_sort, " & _
"ph_post_no, " & _
"ph_post_title, " & _
"ph_externally_funded, " & _
"ph_status, " & _
"ph_directorate, " & _
"ph_service_unit, " & _
"ph_section, " & _
"ph_sub_section, " & _
"ph_name, " & _
"pd_cost_centre, " & _
"cc_description, " & _
"pd_percentage, " & _
"pt_percentage_total " & _
"from vw_sys_post_totals_02 where ph_year = '" & strYear & "'"

Set adoCON = CurrentProject.Connection

adoRST.Open strSQL, adoCON

Set XL = New Excel.Application

XL.Workbooks.Add
XL.Worksheets.Add
XL.ActiveWorkbook.ActiveSheet.Name = "Audit"
XL.Worksheets.Add
XL.ActiveWorkbook.ActiveSheet.Name = "Post Details"

XL.Sheets("Post Details").Select
XL.Range("A1").Select

XL.ActiveCell = "YEAR"
XL.ActiveCell.Offset(0, 1) = "SORT"
XL.ActiveCell.Offset(0, 2) = "POST"
XL.ActiveCell.Offset(0, 3) = "POST TITLE"
XL.ActiveCell.Offset(0, 4) = "EXT FUND"
XL.ActiveCell.Offset(0, 5) = "STATUS"
XL.ActiveCell.Offset(0, 6) = "DIRECTORATE"
XL.ActiveCell.Offset(0, 7) = "SERVICE UNIT"
XL.ActiveCell.Offset(0, 8) = "SECTION"
XL.ActiveCell.Offset(0, 9) = "SUB SECTION"
XL.ActiveCell.Offset(0, 10) = "NAME"
XL.ActiveCell.Offset(0, 11) = "COST CENTRE"
XL.ActiveCell.Offset(0, 12) = "COST CENTRE DESCRIPTION"
XL.ActiveCell.Offset(0, 13) = "PERCENTAGE"
XL.ActiveCell.Offset(0, 14) = "PERCENTAGE TOTAL"

XL.Range("A1:O1").Select
XL.Selection.Font.Bold = True
XL.Selection.HorizontalAlignment = xlCenter
XL.Selection.Interior.ColorIndex = 15

XL.Columns("A:C").ColumnWidth = 6
XL.Columns("D:D").ColumnWidth = 32
XL.Columns("E:F").ColumnWidth = 9
XL.Columns("G:G").ColumnWidth = 13
XL.Columns("H:K").ColumnWidth = 28
XL.Columns("L:L").ColumnWidth = 13
XL.Columns("M:M").ColumnWidth = 31
XL.Columns("N:N").ColumnWidth = 12
XL.Columns("A:C").ColumnWidth = 6
XL.Columns("O:O").ColumnWidth = 18

XL.Columns("E:G").HorizontalAlignment = xlCenter
XL.Columns("L:L").HorizontalAlignment = xlCenter

XL.Columns("A:M").NumberFormat = "@"
XL.Columns("N:O").NumberFormat = "#,##0.00[BLACK];(#,##0.00)[RED]"

XL.Range("A2").Select

XL.Cells(2, 1).CopyFromRecordset adoRST

XL.Visible = True

adoRST.Close
Set adoRST = Nothing
Set adoCON = Nothing

Exit Sub
ERR_ERROR:
Call Errors
End Sub



Steve'o said:
Server = SQL Server 2000 SP4
Client = Access 2000 SP3 (Windows 2000 SP4)

Im using vba in Access to loop through adodb recordset (simply select * from
my_sql2000_view) and output the result to Excel 2000.

The problem is the time, it works, but takes way too long, can someone
explain what I may be doing wrong please?

Data = 2000 rows and 12 columns varchar(100) and 2 columns money

Opening sql2000 view in Access = <2 seconds
ODBC link from within Excel = <10 seconds
docmd.outputto acoutputserverview, "my_view", acFormatXLS,
"c:\temp\export.xls" = <10seconds
Loop through ADODB in Access and put into Excel = 4minutes!!

If possible, I'd like to use the adodb method below because I can format the
spreadsheet and have multiple sheets.

Many thanks for any suggestions!


Private Sub lblExcel_Click()
On Error GoTo ERR_ERROR

Dim strYear As String
Dim adoRST As New ADODB.Recordset, adoCON As New ADODB.Connection,
strSQL As String
Dim XL As Excel.Application

strYear = Nz(Form_FRM_MAIN_MENU.cmboYear, 0)

strSQL = "select * from vw_sys_post_totals_02 where ph_year = '" &
strYear & "'"

Set adoCON = CurrentProject.Connection

adoRST.Open strSQL, adoCON

Set XL = New Excel.Application

XL.Workbooks.Add
XL.Worksheets.Add
XL.ActiveWorkbook.ActiveSheet.Name = "Audit"
XL.Worksheets.Add
XL.ActiveWorkbook.ActiveSheet.Name = "Post Details"

XL.Sheets("Post Details").Select
XL.Range("A1").Select

XL.ActiveCell = "YEAR"
XL.ActiveCell.Offset(0, 1) = "SORT"
XL.ActiveCell.Offset(0, 2) = "POST"
XL.ActiveCell.Offset(0, 3) = "POST TITLE"
XL.ActiveCell.Offset(0, 4) = "EXT FUND"
XL.ActiveCell.Offset(0, 5) = "STATUS"
XL.ActiveCell.Offset(0, 6) = "DIRECTORATE"
XL.ActiveCell.Offset(0, 7) = "SERVICE UNIT"
XL.ActiveCell.Offset(0, 8) = "SECTION"
XL.ActiveCell.Offset(0, 9) = "SUB SECTION"
XL.ActiveCell.Offset(0, 10) = "NAME"
XL.ActiveCell.Offset(0, 11) = "COST CENTRE"
XL.ActiveCell.Offset(0, 12) = "COST CENTRE DESCRIPTION"
XL.ActiveCell.Offset(0, 13) = "PERCENTAGE"
XL.ActiveCell.Offset(0, 14) = "PERCENTAGE TOTAL"

XL.Range("A1:O1").Select
XL.Selection.Font.Bold = True
XL.Selection.HorizontalAlignment = xlCenter
XL.Selection.Interior.ColorIndex = 15

XL.Columns("A:C").ColumnWidth = 6
XL.Columns("D:D").ColumnWidth = 32
XL.Columns("E:F").ColumnWidth = 9
XL.Columns("G:G").ColumnWidth = 13
XL.Columns("H:K").ColumnWidth = 28
XL.Columns("L:L").ColumnWidth = 13
XL.Columns("M:M").ColumnWidth = 31
XL.Columns("N:N").ColumnWidth = 12
XL.Columns("A:C").ColumnWidth = 6
XL.Columns("O:O").ColumnWidth = 18

XL.Columns("E:G").HorizontalAlignment = xlCenter
XL.Columns("L:L").HorizontalAlignment = xlCenter

XL.Columns("A:M").NumberFormat = "@"
XL.Columns("N:O").NumberFormat = "#,##0.00[BLACK];(#,##0.00)[RED]"

XL.Range("A2").Select


Do While Not adoRST.EOF
XL.ActiveCell = adoRST.Fields("ph_year")
XL.ActiveCell.Offset(0, 1) = adoRST.Fields("ph_sort")
XL.ActiveCell.Offset(0, 2) = adoRST.Fields("ph_post_no")
XL.ActiveCell.Offset(0, 3) = adoRST.Fields("ph_post_title")
XL.ActiveCell.Offset(0, 4) = adoRST.Fields("ph_externally_funded")
XL.ActiveCell.Offset(0, 5) = adoRST.Fields("ph_status")
XL.ActiveCell.Offset(0, 6) = adoRST.Fields("ph_directorate")
XL.ActiveCell.Offset(0, 7) = adoRST.Fields("ph_service_unit")
XL.ActiveCell.Offset(0, 8) = adoRST.Fields("ph_section")
XL.ActiveCell.Offset(0, 9) = adoRST.Fields("ph_sub_section")
XL.ActiveCell.Offset(0, 10) = adoRST.Fields("ph_name")
XL.ActiveCell.Offset(0, 11) = adoRST.Fields("pd_cost_centre")
XL.ActiveCell.Offset(0, 12) = adoRST.Fields("cc_description")
XL.ActiveCell.Offset(0, 13) = adoRST.Fields("pd_percentage")
XL.ActiveCell.Offset(0, 14) = adoRST.Fields("pt_percentage_total")
XL.ActiveCell.Offset(1, 0).Select
adoRST.MoveNext
Loop

XL.Range("A2").Select

adoRST.Close

Set adoRST = Nothing
Set adoCON = Nothing

XL.Visible = True

Exit Sub
ERR_ERROR:
Call Errors
End Sub


Many thanks!
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Export to Excel: 2nd, 3rd, etc excel files not opening up 7
Macro Problems in excel 2007 1
Repost! Excel multiple worksheet populate from recordset 2
PLEASE HELP...How do I update a pivot table with VBA? 0
Excel macros page breaks but not on row 1 and column value in footer 3
Need assistance with secondary axis in Excel 2007 0
Exporting Access to Excel on Multiple Named extra sheets created 1
my latest C++ excel OLE automation code 4

Top