PDA

View Full Version : Solved: Insert a row of data before the field headers



jason_kelly
03-01-2011, 01:49 PM
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
03-01-2011, 03:10 PM
perhaps try: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
?

jason_kelly
03-02-2011, 07:54 AM
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