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() 'requires reference to Microsoft Excel Object Library 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 '<<<Connect to this currently open database 'connect to primary table Set tblrst = db.OpenRecordset("tblEmployeeInfo") '<<<***Replace with your Primary Table's Name*** tblrst.MoveFirst '<<<move to the first record of primary table Do Until tblrst.EOF '<<<Loop commands until end of recordset reached 'SQL statement used to query chosen records in data table 'tblrst!EmployeeID pulls data from the EmployeeID field strTable = "SELECT tblOrders.* FROM tblOrders INNER JOIN tblEmployeeInfo " _ & "ON tblOrders.EmployeeID = tblEmployeeInfo.EmployeeID " _ & "WHERE (([tblEmployeeInfo].[EmployeeID]= " & tblrst!EmployeeID & "));" '^<<<You must use a Bang (!) between tblrst & field name to get the field's value strExcelFile = "C:\Test\" & tblrst!EmpName '<<<Creates new excel file named for current primary table's field value Set rst = db.OpenRecordset(strTable) '<<<Open query results from data table for primary table's current field value 'get number of records in recordset rst.MoveLast '<<<Required to get total number of records in recordset rowsToReturn = rst.RecordCount rst.MoveFirst '<<<Move back to start of recordset '^ if MoveFirst is not used then only last record will be gathered If rowsToReturn <= rst.RecordCount Then '<<<Do as long as there are records to work 'set reference to Excel to make Excel visible Set xlApp = CreateObject("Excel.Application") xlApp.Application.Visible = True '<<<Change to False to make Excel invisible 'set references to workbook and worksheet Set wkb = xlApp.Workbooks.Add '<<<Create new workbook Set objSheet = xlApp.ActiveWorkbook.Sheets(1) '<<<Add worksheet to workbook 'write column names to the first worksheet row For iCol = 0 To rst.Fields.count - 1 objSheet.Cells(1, iCol + 1).Value = rst.Fields(iCol).Name Next 'specify cell range to recieve data Set rng = objSheet.Cells(2, 1) 'copy specified number of records to worksheet rng.CopyFromRecordset rst, rowsToReturn 'autofit columns to make data fit objSheet.Columns.AutoFit 'close the workbook wkb.SaveAs FileName:=strExcelFile '<<<Save as employee's name wkb.Close '<<<Close workbook because we are done with it 'quit excel and release object variables Set objSheet = Nothing Set wkb = Nothing xlApp.Quit Set xlApp = Nothing End If tblrst.MoveNext '<<<Move to next primary table field value Loop MsgBox "All records exported to Excel." 'close database connection tblrst.Close Set tblrst = Nothing rst.Close Set rst = Nothing db.Close Set db = Nothing End Sub

How to use:

  1. Copy code above into a new module
  2. Click on Tools
  3. Click References
  4. Click the checkbox next to Microsoft Excel xx.0 Object Library (you may have 10.0, 11.0, or 12.0)
  5. Click Ok to set the reference
  6. Replace tblEmployeeInfo with the name of your Primary table
  7. Write a SQL SELECT statement that pulls records from your Data Table
  8. Ensure your WHERE clause reference the unique values that link your Primary and Data tables
  9. Change strExcelFile to the full filepath where you want your reports to be created
  10. Be sure you allow for the reports to have unique names so they are not overwritten
 

Test the code:

  1. Make all changes to the code liste in the How to use section
  2. Check that your Primary table contains records
  3. Check that your Data contains records
  4. Place your cursor anywhere within the code
  5. Press F5 to run the code
 

Sample File:

Export To Excel.zip 66.26KB 

Approved by mdmackillop


This entry has been viewed 329 times.

Please read our Legal Information and Privacy Policy
Copyright @2004 - 2020 VBA Express