Solved: Insert a row of data before the field headers
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.
Code:
'-------------------------------------------------------
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
