Solved: Insert a row of data before the field headers

[jason_kelly]

Hi There,

I need your help,

I am trying to export my data from Access to Excel which works 100% perfectly however, i'd like to insert a row of text and then a blank row before my column headers make it on the list.

For an example see the <<< >>> notations below.

Much thanks and appreciation for all your help.

Cheers,

Jay.

'-------------------------------------------------------
Public Sub ExportTOExcel()
'-------------------------------------------------------
Dim oApp As Object
Dim oWB As Object
Dim maxRows
Dim curRecs
Dim FullFileName
Set oApp = CreateObject("Excel.Application")
oApp.Visible = False
Set oWB = oApp.Workbooks.Add

   
  If Val(oApp.Version) < 12 Then
FullFileName = Application.GetSaveAsFilename("Export.xls", _
    "Excel file (*.xls),*.xls", 1, frmSplash.IMTS_Caption & " - Export to")
    maxRows = 65000
  Else
FullFileName = Application.GetSaveAsFilename("Export.xlsx", _
    "Excel file (*.xlsx),*.xlsx", 1, frmSplash.IMTS_Caption & " - Export to")
    maxRows = 1048576
  End If
    If FullFileName <> False Then
  If recCount > maxRows Then
    loops = recCount / maxRows
  Else
    loops = 1
  End If
  
  curRecs = maxRows
  
  ' Get the Headers
  ReDim hdrs(rs.Fields.Count)
  x = 0
  For Each fld In rs.Fields
    hdrs(x) = fld.Name
    x = x + 1
  Next fld
  
  <<<FIRST ROW: "This is the first line of text">>>
  <<<2ND ROW: BLANK >>>

      For i = 0 To rs.Fields.Count - 1
        oWB.Sheets(1).Cells(1, i + 1).Value = rs.Fields(i).Name
    Next
    
  For i = 1 To loops
    
    oWB.Sheets(1).Range("1:1").Font.Bold = True
    oWB.Sheets(1).Cells(2, 1).CopyFromRecordset rs, maxRows
    oApp.Selection.CurrentRegion.RowHeight = 11
    oApp.Selection.CurrentRegion.Font.Name = tahoma
    oApp.Selection.CurrentRegion.Font.Size = 8
        
        curRecs = curRecs + maxRows
    If i <> loops Then
      Set oWB = oWB.Worksheets.Add
      oWB.Name = shtName & i + 1
    End If
  Next i
  
    oWB.SaveAs (FullFileName)
    oWB.Close
    Set oWB = Nothing
    oApp.Quit
    Set oApp = Nothing
    Else
    Exit Sub
    
End If
End Sub

[p45cal]

perhaps try:[VBA]oWB.Sheets(1).Cells(1, 1) = "This is the first line of text"
' <<<2ND ROW: BLANK >>> see red 3 and 4 below

For i = 0 To rs.Fields.Count - 1
oWB.Sheets(1).Cells(3, i + 1).Value = rs.Fields(i).Name
Next

For i = 1 To loops

oWB.Sheets(1).Range("1:1").Font.Bold = True
oWB.Sheets(1).Cells(4, 1).CopyFromRecordset rs, maxRows
[/VBA]?

[jason_kelly]

Thanks very much P45Cal.

It worked like a charm and was exactly what I was looking for.

Thanks very much for all your help.

Cheers,

Jay