|
|
|
|
|
|
Access
|
Create Individual Reports Based On The Value Of A Given Field In A Related Table
|
|
Ease of Use
|
Intermediate
|
Version tested with
|
2003
|
Submitted by:
|
CreganTur
|
Description:
|
This code is designed to create individual reports as Excel Workbooks based on the value of a given field in a related table.
|
Discussion:
|
Suppose you need to create individual reports representing order quantities per employee. Using Data Access Object (DAO) connections, this code looks at each employee, runs a query against the table of Orders, and writes the resulting recordset to an Excel spreadsheet. These same principals can be used to create reports that show all orders for each product type, or any other combination of Data as long as both tables have a field in common.
You need at least 2 different tables to utilize this code- a Primary table and a Data table. The Primary table is a table of unique records, like a list of employees, products, or offices. The Data table needs to have at least 1 field in common with your Primary table. This is required so that all records in the Data table can be exported to an Excel Workbook for each unique record in the Primary table.
|
Code:
|
instructions for use
|
Sub ExportToExcelDAO()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim xlApp As Object
Dim wkb As Object
Dim rng As Object
Dim strExcelFile As String
Dim strTable As String
Dim iCol As Integer
Dim rowsToReturn As Integer
Dim objSheet As Object
Dim tblrst As DAO.Recordset
Set db = CurrentDb
Set tblrst = db.OpenRecordset("tblEmployeeInfo")
tblrst.MoveFirst
Do Until tblrst.EOF
strTable = "SELECT tblOrders.* FROM tblOrders INNER JOIN tblEmployeeInfo " _
& "ON tblOrders.EmployeeID = tblEmployeeInfo.EmployeeID " _
& "WHERE (([tblEmployeeInfo].[EmployeeID]= " & tblrst!EmployeeID & "));"
strExcelFile = "C:\Test\" & tblrst!EmpName
Set rst = db.OpenRecordset(strTable)
rst.MoveLast
rowsToReturn = rst.RecordCount
rst.MoveFirst
If rowsToReturn <= rst.RecordCount Then
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
Set wkb = xlApp.Workbooks.Add
Set objSheet = xlApp.ActiveWorkbook.Sheets(1)
For iCol = 0 To rst.Fields.count - 1
objSheet.Cells(1, iCol + 1).Value = rst.Fields(iCol).Name
Next
Set rng = objSheet.Cells(2, 1)
rng.CopyFromRecordset rst, rowsToReturn
objSheet.Columns.AutoFit
wkb.SaveAs FileName:=strExcelFile
wkb.Close
Set objSheet = Nothing
Set wkb = Nothing
xlApp.Quit
Set xlApp = Nothing
End If
tblrst.MoveNext
Loop
MsgBox "All records exported to Excel."
tblrst.Close
Set tblrst = Nothing
rst.Close
Set rst = Nothing
db.Close
Set db = Nothing
End Sub
|
How to use:
|
- Copy code above into a new module
- Click on Tools
- Click References
- Click the checkbox next to Microsoft Excel xx.0 Object Library (you may have 10.0, 11.0, or 12.0)
- Click Ok to set the reference
- Replace tblEmployeeInfo with the name of your Primary table
- Write a SQL SELECT statement that pulls records from your Data Table
- Ensure your WHERE clause reference the unique values that link your Primary and Data tables
- Change strExcelFile to the full filepath where you want your reports to be created
- Be sure you allow for the reports to have unique names so they are not overwritten
|
Test the code:
|
- Make all changes to the code liste in the How to use section
- Check that your Primary table contains records
- Check that your Data contains records
- Place your cursor anywhere within the code
- Press F5 to run the code
|
Sample File:
|
Export To Excel.zip 66.26KB
|
Approved by mdmackillop
|
This entry has been viewed 335 times.
|
|