headings not transferred to excel

[Chimp8471]

i am using some code to export my query to excel to then create a fancy chart, this was a system setup by someone else who has now left the company.

the code is below, everything works fine except, i dont get the field headings transfered across, can someone please inform me where and how i should modify my code to take the headings across aswell please.

cheers

Andy

Option Compare Database
Option Explicit

Dim objExcel As Excel.Application    'This will give an error if no reference set to Excel object

Const DATE_RANGE = 2 'optRange= 2 for entering in a Date Range

'constant for columns of list boxes that have data
' Const MATERIAL_FILTER = 1

Const GRAPH_QUERY = 1
Const GRAPH_TEMPLATE = 2

Private Sub cmdClose_Click()
On Error GoTo Err_cmdClose_Click


    DoCmd.Close
DoCmd.OpenForm "frmGraphsMenu", acNormal, "", "", , acNormal
Exit_cmdClose_Click:
    Exit Sub

Err_cmdClose_Click:
    MsgBox Err.Description
    Resume Exit_cmdClose_Click
    
End Sub

Private Sub cmdPreviewOEE_Click()
    GraphMake False
End Sub

Private Sub cmdPrint_Click()
    GraphMake True
End Sub



Private Sub optRange_AfterUpdate()
    If optRange = DATE_RANGE Then
        txtYearStartOEE.Enabled = True
        txtYearEndOEE.Enabled = True
    Else
        txtYearStartOEE.Enabled = False
        txtYearEndOEE.Enabled = False
    End If
    YearPeriodSet
End Sub

Sub YearPeriodSet()
    Dim dbs As Database
    Dim PeriodTable As Recordset
    Set dbs = DBEngine.Workspaces(0).Databases(0)
'    Set PeriodTable = dbs.OpenRecordset("tblSystemDataCurrentPeriod")
'Purpose: Fill start and end year/periods in txt boxes when we want to see all periods
'Called From: optRange_AfterUpdate
    txtYearStartOEE = 2000
    txtYearEndOEE = 3000
End Sub

Private Function RequiredFieldsOK() As Boolean
On Error GoTo RequiredFieldsOK_Error

    'Ensure that all required fields have data in them
 '   If IsNull(lstMaterial.Column(MATERIAL_FILTER)) Then
 '       MsgBox "Please choose a Material type"
'        GoTo RequiredFieldsOK_Exit
 '   End If
    
    If IsNull(lstGraphs) Then
        MsgBox "Please choose a graph"
        GoTo RequiredFieldsOK_Exit
    End If

    RequiredFieldsOK = True
   

RequiredFieldsOK_Exit:
    Exit Function

RequiredFieldsOK_Error:
    MsgBox "Error number " & Err.Number & ": " & Err.Description, vbOKOnly + vbInformation, "RequiredFieldsOK"
    Resume RequiredFieldsOK_Exit

End Function

Sub GraphMake(flgPrint As Boolean)
    
    Dim rs As Recordset
    Dim qdf As QueryDef
    Dim strTemplate As String
    Dim strQuery As String
On Error GoTo GraphMake_Error

    If RequiredFieldsOK() Then
        
        'Create recordset and get values to pass to ExcelDataTransfer
        strQuery = lstGraphs.Column(GRAPH_QUERY)
        strTemplate = lstGraphs.Column(GRAPH_TEMPLATE)

        
        Set qdf = CurrentDb.QueryDefs(strQuery)
        Set rs = qdf.OpenRecordset(dbOpenSnapshot)
    
        If ExcelDataTransfer(rs, 2, 1, objExcel, strTemplate, "Data") Then
            
            'Change Title of Graph
On Error GoTo GraphMake_Exit
    'Error will occur if there is no graph sheet
            objExcel.Sheets("Chart").Select
On Error GoTo GraphMake_Error
            With objExcel.ActiveChart
                .HasTitle = True
                .ChartTitle.Characters.Text = "OEE Trend for line H6 " '& [CmbGraphYearSelectOEE]
            End With
                        
            If flgPrint Then
                objExcel.ActiveChart.PrintOut
            End If
            
            Set objExcel = Nothing
        End If
    End If

GraphMake_Exit:
    Exit Sub

GraphMake_Error:
    MsgBox "Error number " & Err.Number & ": " & Err.Description, vbOKOnly + vbInformation, "GraphMake"
    Resume GraphMake_Exit

End Sub
Private Sub OpenCalOEE_Click()
On Error GoTo Err_OpenCal_Click

    Dim stDocName As String
    Dim stLinkCriteria As String

    CalStartRef = "OEEgraphs"
    'DoCmd.Minimize
    
    stDocName = "frmCalender"
    DoCmd.OpenForm stDocName, , , stLinkCriteria

Exit_OpenCal_Click:
    Exit Sub

Err_OpenCal_Click:
    MsgBox Err.Description
    Resume Exit_OpenCal_Click
    
End Sub

 

[The_Doc_Man]

If you want to SEE something in a column, PUT it in a column.

Transferring only the recordset, even through the APPS object, doesn't transfer the table/query. It transfers the columns.

If you want column headers of X, Y, and Z, there has to be a place where you stuff X, Y, and Z into the appropriate columns. If X, Y, and Z are column names corresponding to field names in a table, the field names are not stored in the table (they are in the tabledef), so won't get transferred.

If I were to do this (not using your example), I would have my loop to load records, but before it I would have something that loaded the field names from the recordset. After it was open and after the first record was retrieved, I would use the recordset.fields.name specification to transfer the column headers.

Or did I miss your question entirely?