Heading Rows (1 Viewer)

[Bunga2017]

Dear mr/mrs,

Can someone help me with vba, I use below VBA to export data from Access to excel. I have problem with heading rows, not to be delete please help how ( see photos)


Private Sub Command0_Click()
ExportToXLS
End Sub


Public Function ExportToXLS()

Dim objExcel As Excel.Workbook
Set objExcel = Workbooks.Add
Dim objSheet As Excel.Worksheet
Set objSheet = objExcel.Worksheets.Add()
objSheet.Name = "Data"

Dim rec As Recordset
Set rec = CurrentDb.OpenRecordset("SELECT * FROM tblStaf")

objSheet.Range("A4").CopyFromRecordset rec


Dim sPath As String
sPath = CurrentProject.Path

Dim sFilename_full As String
sFilename_full = sPath & "\DataStaf"
On Error Resume Next

objExcel.Close savechanges:=True, FileName:=sFilename_full



Set objExcel = Nothing

End Function


Thank you
Bunga

 

[Cronk]

I would use vba to insert the header after you export the recordset data.

Easiest way to generate the vba to do this is to go into Excel and record a macro of your actions inserting the header and formatting the cells. Then copy the macro vba into your function.

 

[OriOn]

Hello, it's not that the export is deleting your header/title, you are creating a new workbook (i.e.: an empty one) and start writing in the lines from the 4th on.

There are two options to have your title displayed:
- Since it is a rather simple one you could had a few lines of code to write your title and format it as needed (using your objSheet object).

- Create an excel template (or a simple empty excel file with just the title it would work) open it instead of creating a new workbook.
updating your

Set objExcel = Workbooks.Add()

by

Set objExcel = Workbooks.Add("your template file path and name")

for the use of a template
or by

Set objExcel = Workbooks.Open("your empty file path and name")

for the use of an empty table

Using this you should also select the worksheet instead of creating a new one and naming it.

Cheers

 

[Bunga2017]

Dear Orion,

Please help,

Private Sub Command0_Click()
ExportToXLS
End Sub


Public Function ExportToXLS()

Dim objExcel As Excel.Workbook
Set objExcel = Workbooks.Add()
Dim objSheet As Excel.Worksheet
Set objSheet = objExcel.Worksheets.Add()
objSheet.Name = "Data"
Set objExcel = Workbooks.Add("C:\ACCESS\DataStaf.xlsx")
Set objExcel = Workbooks.Open("C:\ACCESS\DataStaf.xlsx")

Dim rec As Recordset
Set rec = CurrentDb.OpenRecordset("SELECT * FROM tblStaf")

objSheet.Range("A4").CopyFromRecordset rec


Dim sPath As String
sPath = CurrentProject.Path

Dim sFilename_full As String
sFilename_full = sPath & "\DataStaf"
On Error Resume Next

objExcel.Close savechanges:=True, FileName:=sFilename_full



Set objExcel = Nothing

End Function


Thank you
Bunga

 

[OriOn]

Hello,
Maybe I wasn't clear enough I listed choices so you had to pick one of the solution matching the most your requirements.
From your reply I believe that you want to go for the empty table.
There is quick correction of your function
2 things to make sure of
- DataStaf.xlsx (the empty one) is in the projet directory.
- DataStaf.xlsx has a worksheet named Data with your header/title.

Public Function ExportToXLS()
[COLOR=Green]'  variables declaration[/COLOR]
Dim objExcel As Excel.Workbook
Dim objSheet As Excel.Worksheet
Dim sPath As String
Dim sFilename_full As String
Dim rec As Recordset

[COLOR=Green]' Open your recodset[/COLOR]
Set rec = CurrentDb.OpenRecordset("SELECT * FROM tblStaf")
[COLOR=YellowGreen]
[COLOR=Green]' Open your empty table[/COLOR][/COLOR]
sPath = CurrentProject.Path
Set objExcel = Workbooks.Open(sPath & "\DataStaf.xlsx")
[COLOR=Green]' Select the worksheet to write in[/COLOR]
Set objSheet = objExcel.Worksheets("Data")
[COLOR=Green]' write from line 4 on.[/COLOR]
objSheet.Range("A4").CopyFromRecordset rec

[COLOR=Green]' create the file name to store the filled in table (and not erase the empty table for next use)
' here I just added the date "_YYYYMMDD.xlsx" at the end of the filename[/COLOR]
sFilename_full = sPath & "\DataStaf_" & Year(Now) & Month(Now) & Day(Now) & ".xlsx"

[LEFT] [COLOR=Green]' save the file and close the workbook[/COLOR]
[/LEFT]
 objExcel.Close savechanges:=True, FileName:=sFilename_full

[COLOR=Green]' cleanup variables[/COLOR]
Set objExcel = Nothing
Set objSheet = Nothing
Set rs = Nothing

End Function

 

[Bunga2017]

Dear Orion,

It's working, Well Done
I want to thank you for all the support and concern.

Bunga