copy query field name --> excel field name 1

[mbowler9]

Hello all.

I have taken a few classes in VB, but I am new to using VBA with Access and excel.

I would like to modify the existing code below to put the field headers in my query as the column headers in the spreadsheet.

Any suggestions?

I would also like some suggestions on where to look for information on saving spreadsheets.

Thanks in advance.

'************* Code Start *****************
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Sub sCopyFromRS()
'Send records to the first
'sheet in a new workbook
'
Dim rs As DAO.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("allmid_TD_LOAD_REPORT_ITO", 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 End *****************

 

[BillPower]

Hi,

This should do it for you, have marked changes in red:
Dim rs As DAO.Recordset
Dim intMaxCol As Integer
Dim intMaxRow As Integer
Dim objXL As Excel.Application
Dim objWkb As Workbook
Dim objSht As Worksheet
Dim i As Integer
Set rs = CurrentDb.OpenRecordset("allmid_TD_LOAD_REPORT_ITO", 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 i = 0 To rs.Fields.Count - 1
.range(.Cells(1, i + 1), .Cells(intMaxRow, intMaxCol)) = rs.Fields(i).Name
Next i
.range(.Cells(2, 1), .Cells(intMaxRow, intMaxCol)).CopyFromRecordset rs
End With
End With
End If

Bill

 

[mbowler9]

thanks. I will give it a try.