Exporting an Access Table into Excel one line at a time

[DaveSwanton77]

I have a database set up to run multiple queries to produce an output table. Rather that using the TransferSpreadSheet action, I would like to export the table line by line.

This is the output code for one report and this works fine. But the other report I wish to create does not have static recordset fieldnames as it is built from a cross tab query.

The code below builds an array using each field in the recordset and writes it in one go as the fieldnames do not change.

Public Sub subIncentiveReportOut()
On Error GoTo Err_subIncentiveReportOut
Dim ExcelApp As Excel.Application
Dim Excelfn As String
Dim ExcelRow As Long
Dim rng As Excel.Range

' Database Variables
Dim cnn As ADODB.Connection
Dim sql As String
Dim rs As ADODB.Recordset

' Data Variables
Dim Arr(13)
Dim NewFad As String

'------------------------------------------


Set ExcelApp = CreateObject("Excel.Application")
Set wb = ExcelApp.WorkBooks.Add

' Set up the spreadsheet
subSetupIncSheet

Set cnn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.ActiveConnection = cnn
.CursorType = adOpenStatic
.LockType = adLockReadOnly
.Open "qry_IncentiveSchemeReport"
End With

' Set the starting excel row
ExcelRow = 3

Forms!frmInfodlg!Line4.Visible = True
Forms!frmInfodlg!Line4.Caption = "0 lines written"
Forms!frmInfodlg.Repaint

Do Until rs.EOF
Arr(0) = "'" & rs("FADCode")
Arr(1) = rs("OfficeName")
Arr(2) = rs("OfficeType")
Arr(3) = rs("SegmentType")
Arr(4) = rs("HoAName")
Arr(5) = rs("RLMName")
Arr(6) = rs("AgentName")
Arr(7) = rs("TelNo")
Arr(8) = rs("IncentiveGroup")
Arr(9) = rs("Total Received")
Arr(10) = rs("Rejected DMS")
Arr(11) = rs("Rejected Surveyor")
Arr(12) = rs("Percent Rejected")
Arr(13) = rs("Percent Passed")

Set rng = wb.ActiveSheet.Range("A" & ExcelRow).Resize(1, 14)
rng.Value = Arr

ExcelRow = ExcelRow + 1
Forms!frmInfodlg!Line4.Caption = ExcelRow - 3 & " lines written"
Forms!frmInfodlg.Repaint

rs.MoveNext

Loop

rs.Close

Excelfn = GetReportfnStart() & " - Incentive Report.xls"

Forms!frmInfodlg!Line5.Caption = "Formatting Excel spreadsheet...."
Forms!frmInfodlg!Line5.Visible = True
Forms!frmInfodlg.Repaint
subFormatIncentiveReport

Forms!frmInfodlg!Line5.Caption = "Saving file " & Excelfn
Forms!frmInfodlg.Repaint

wb.SaveAs Excelfn
wb.Close

ExcelApp.Quit

MsgBox "Incentive Scheme Report saved to" & vbCr & Excelfn, vbInformation, "Report Complete"

Exit_subIncentiveReportOut:
Exit Sub

Err_subIncentiveReportOut:
MsgBox Err.Description
Resume Exit_subIncentiveReportOut
End Sub


Thanks in Advance

Cheers

Dave

 

[bat17]

Hi Dave
You can dump a recordset straight into Excel without using an array by using
.Cells(3, 3).CopyFromRecordset rst

where rst is your recordset. there is also an option to limit the number of records returned.

For the crosstab you could just dump the original data in and let Excel do the pivot table bit or you can read of the field names and insert them into Excel using something like
j = lngStartCol
For Each fld In rst.Fields
.Cells(5, j) = fld.Name
j = j + 1
Next fld

And then use
.Cells(6,lngStartCol).CopyFromRecordset rst
to insert the data

HTH (and makes sense)

Peter

 

[DaveSwanton77]

Thanks very much Peter, I've managed to integrate your suggestion into my VB and it works fine.


Cheers

Dave