Transfer Field Column Names

[rtg]

Below is code I'm using to export Tables or queries to Excel. It sets up the table or query to a specific range in a specific worksheet. My problem is that I don't know how to transfer the table or query field column names aswell. I know that I could use TransferSpreadsheet method and there is an option to transfer Column names but I wanted to try it this way instead.

Dim objExcel As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim DB As Database
Dim rst As Recordset

Const constMAX_ROWS = 10000
Const constSHT_NAME = "WorkSheet1"
Const constWKB_NAME = "c:\Excelsheet.xls"
Const constRANGE = "A2,P100"


Set DB = CurrentDb
Set objExcel = New Excel.Application
Set rst = DB.OpenRecordset("PRProject", dbOpenSnapshot)

With objExcel
.Visible = True
Set objWkb =.Workbooks.Open(constWKB_NAME)
On Error Resume Next
Set objSht = objWkb.Worksheets(constSHT_NAME)

If Not err.Number = 0 Then
Set objSht = objWkb.Worksheets.Add
objSht.Name = constSHT_NAME
End If

err.Clear
On Error GoTo 0
objSht.Range(constRANGE).CopyFromRecordset rst
End With

Set objSht = Nothing
Set objWkb = Nothing
Set objExcel = Nothing
Set rst = Nothing
Set DB = Nothing


Does anyone know how I can amend this to include column names in the Excel Worksheet?

 

[bobjames]

Try inserting this code before you set your object varibles to Nothing:

Dim x As Integer
For x = 0 To rst.Fields.Count - 1
objSht.Cells(1, x + 1) = rst(x).Name
Next x


I'd appreciate it if you would let know if this code works for you.

Bob

 

[rtg]

Thank you Bob this works well. I hadn't realised that the recordset object property Name had the recordset field names.