Here you are! I tested it, and it works a treat!
Some changes I made to the way it works:
- It creates a new worksheet in the Excel file and adds to that, so data won't get overwritten by mistake
- The field names from the Access table become Column headers in the worksheet (Row 1)
The name of the table you want to transfer is passed as a parameter to the procedure
The Excel file name is hard-coded for testing, but you could make it a second parameter of the procedure if you wanted to
You might want to run it with the Excel window invisible (xl.Visible = False), because you close the spreadsheet at the end of the procedure anyway.
To run the procedure, just use Test2 "Tablename"
I think you had it as a button on_click procedure in a form, so you would need to have it take the table name from a form control, but that's a trivial change.
Code:
Sub test2(TableName As String)
Dim xl As Excel.Application
Set xl = New Excel.Application
xl.Visible = True
Dim fld As Field, FieldCount As Integer, J As Integer
Dim ws As Worksheet
xl.Workbooks.Open ("d:\ms office\MS Excel\testing.xlsx")
Set ws = xl.ActiveWorkbook.Sheets.Add
ws.Select
Dim db As DAO.Database, rownum As Long
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset(TableName)
rownum = 1
rs.MoveFirst
'
' Fieldcount contains the number of fields in the recordset
'
FieldCount = rs.Fields.Count
'
' first row of the spreadsheet contains the fieldnames, making it a header row
'
For J = 1 To FieldCount
ws.Cells(rownum, J).Value = rs.Fields(J - 1).Name ' Use j-1 because recordset field index is zero-based
Next J
'
' Now copy the data from the recordset to the Excel spreadsheet rows 2...
'
Do While Not rs.EOF
rownum = rownum + 1
For J = 1 To FieldCount
ws.Cells(rownum, J).Value = rs.Fields(J - 1).Value ' Use j-1 because recordset field index is zero-based
Next J
rs.MoveNext
Loop
xl.ActiveWorkbook.Close (True)
xl.Quit
End Sub