Export query to Excel with headers (1 Viewer)

[hockeyfan21]

Hi there, I've looked at many posts where they are using blnHeaderRow = True but I can't get it to work for me. No errors, just won't bring over the headers from my Access query. I've tried placing the line everywhere in my code with no success. Any ideas as to where i might be going wrong here?

Thank you!
Toni

Private Sub Command0_Click()

'Private Sub ToExcel_Click()
'declare variables
Dim Distinct As DAO.Recordset
Dim NeedComments As DAO.Recordset
Dim sSql As String
Dim xlApp As Excel.Application
Dim xlWb As Excel.Workbook
Dim xlWs As Excel.Worksheet
Dim r As Excel.Range
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean

blnEXCEL = False

Const path As String = "C:\Users\THART2\"


'get a recordset of distinct Team names
sSql = "SELECT DISTINCT Team FROM Query1"
Set Distinct = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)


blnHeaderRow = True
'Open Excel and make it visible
Set xlApp = New Excel.Application

xlApp.Visible = True


'Step through each Team
While Not Distinct.EOF

'Get the records associated with this Team
sSql = "SELECT ID, [Initiative Nm], [Lnch Date], [Mat Nbr],[Mat Desc],[Distrib Mthd],[Qty on order],[Launch Comments],Team,Comments FROM Query1 WHERE Team='" & Distinct(0) & "'"
'Debug.Print sSql

Set NeedComments = CurrentDb.OpenRecordset(sSql, dbOpenSnapshot)

'Create a new workbook
Set xlWb = xlApp.Workbooks.Add()
Set xlWs = xlWb.ActiveSheet

'Get the range to paste into
Set r = xlWs.Range("A1")


'Copy to excel
r.CopyFromRecordset NeedComments


'Name the worksheet
xlWs.Name = Distinct(0)
'move to the next Team

'Save the workbook
xlWb.SaveAs path & Distinct(0) & " " & Format(Now(), "MMDDYY")
'close the workbook
' xlWb.Close False
Distinct.MoveNext


Wend
'Quit excel
xlApp.Quit
End Sub

 

[pbaldy]

You're setting a variable, but you don't do anything with it. A quick Google found this:

http://www.accessmvp.com/kdsnell/EXCEL_Export.htm

which includes this relevant bit:

      If blnHeaderRow = True Then
            For lngColumn = 0 To rst.Fields.Count - 1
                  xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
            Next lngColumn
            Set xlc = xlc.Offset(1,0)
      End If

 

[GregRun]

Have not heard of that. Are you sure it's not a defined variable in the code you're reading?

That said, here is what I do:

Dim lvlColumn As Integer
Dim RangeName as String
Dim xlSheet As Excel.Worksheet

RangeName = Me.SomeField
Set xlSheet = xlWorkbook.Sheets(1)
For lvlColumn = 0 To tbl.Fields.Count - 1
    xlSheet.Cells(1, lvlColumn + 1).Value = tbl.Fields(lvlColumn).Name
Next
With xlSheet
    .Range("A2").CopyFromRecordset tbl
    .Name = TName
    .ListObjects.Add(xlSrcRange, , , xlYes).Name = TableName
    .Columns.AutoFit
End With