exporting recordset to Excel, missing header

  • Thread starter Thread starter Peter
  • Start date Start date
P

Peter

Hi there,

I found the following code from Dev Ashish very useful for exporting my
query to Excel.
The only problem is, that the header is missing in the Excel sheet.

Any idea how to export including the header of the query?

Alternatively I tried to use DoCmd.OutputTo acOutputQuery, which
requires or requests a output file. How could I use this, with opening
an empty, unnamed Excel sheet?


Thanx,

Peter

'Code Courtesy of
'Dev Ashish
'
Sub sCopyFromRS()
'Send records to the first
'sheet in a new workbook
'
Dim rs As Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Set rs = CurrentDb.OpenRecordset("Customers", _
dbOpenSnapshot)
intMaxCol = rs.Fields.Count
If rs.RecordCount > 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
Set objXL = New Excel.Application
With objXL
.Visible = True
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
With objSht
.Range(.Cells(1, 1), .Cells(intMaxRow, _
intMaxCol)).CopyFromRecordset rs
End With
End With
End If
End Sub
 
'Code Courtesy of
'Dev Ashish
'Modified by Ken Snell
'
Sub sCopyFromRS()
'Send records to the first
'sheet in a new workbook
'
Dim rs As Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim lngFields As Long
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Set rs = CurrentDb.OpenRecordset("Customers", _
dbOpenSnapshot)
intMaxCol = rs.Fields.Count
If rs.RecordCount > 0 Then
rs.MoveLast: rs.MoveFirst
intMaxRow = rs.RecordCount
Set objXL = New Excel.Application
With objXL
.Visible = True
Set objWkb = .Workbooks.Add
Set objSht = objWkb.Worksheets(1)
With objSht
For lngFields = 0 To rs.Fields.Count - 1
.Range(.Cells(1, lngFields + 1).Value = _
rs.Fields(lngFields).Name
Next lngFields
.Range(.Cells(2, 1), .Cells(intMaxRow + 1, _
intMaxCol)).CopyFromRecordset rs
End With
End With
End If
End Sub
 
...
'Code Courtesy of
'Dev Ashish
'Modified by Ken Snell
'
Sub sCopyFromRS()
'Send records to the first
'sheet in a new workbook
<<snip>>
Click to expand...

Just execute this (the Jet provider creates the workbook and worksheet):

SELECT
*
INTO
[Excel 8.0;HDR=Yes;Database=C:\MyNewBook.xls].Sheet1
FROM Customers
;

Jamie.

--
 
Back
Top