Hi all, heres some code I mashed together from some stuff on the web and some code of my own. This will take an access table and write it to an Excel workbook but allow you to control how many records go on each worksheet. On last check this works fine but please let me know if it fails. You should already have an excel workbook saved as a template.
Code:
Option Compare Database
Option Explicit
Public Sub ExportExcel()
Dim lngColumn As Long
Dim xlx As Object, xlw As Object, xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean, blnHeaderRow As Boolean
Dim counter As Integer, pageNum As Integer
counter = 0
pageNum = 1
blnEXCEL = False
' Replace True with False if you do not want the first row of
' the worksheet to be a header row (the names of the fields
' from the recordset)
blnHeaderRow = True
' Establish an EXCEL application object
On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set xlx = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0
' Change True to False if you do not want the workbook to be
' visible when the code is running
xlx.Visible = True
' Replace C:\Filename.xls with the actual path and filename
' of the EXCEL file into which you will write the data
'Set xlw = xlx.Workbooks.Open("C:\Filename.xls")
Set xlw = xlx.Workbooks.Open("C:\Filename.xls")
' Replace WorksheetName with the actual name of the worksheet
' in the EXCEL file
' (note that the worksheet must already be in the EXCEL file)
'Set xls = xlw.Worksheets("WorksheetName")
Set xls = xlw.worksheets("WorksheetName")
' Replace A1 with the cell reference into which the first data value
' is to be written
Set xlc = xls.Range("A1") ' this is the first cell into which data go
Set dbs = CurrentDb()
' Replace QueryOrTableName with the real name of the table or query
' whose data are to be written into the worksheet
'Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)
Set rst = dbs.OpenRecordset("QueryOrTableName", dbOpenDynaset, dbReadOnly)
If rst.EOF = False And rst.BOF = False Then
rst.MoveFirst
Do While rst.EOF = False
If pageNum <> 1 Then
Set xls = xlw.worksheets.Add
xls.Name = "Page" & pageNum
Set xlc = xls.Range("A1")
xls.Move After:=xlw.Sheets(xlw.Sheets.Count)
End If
If blnHeaderRow = True Then
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Name
Next lngColumn
Set xlc = xlc.Offset(1, 0)
End If
' write data to worksheet
' set the counter < num to the maximum number of
' rows in each worksheet
Do While counter < num And rst.EOF = False
For lngColumn = 0 To rst.Fields.Count - 1
xlc.Offset(0, lngColumn).Value = rst.Fields(lngColumn).Value
Next lngColumn
rst.MoveNext
Set xlc = xlc.Offset(1, 0)
counter = counter + 1
Loop
pageNum = pageNum + 1
counter = 0
Loop
End If
rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing
Set xlc = Nothing
Set xls = Nothing
xlw.Close True ' close the EXCEL file while saving.
Set xlw = Nothing
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Sub
Comments/critiques are more than welcome.