Export Access Report to Excel - Different Workbooks

I currently have a database with all of our company's inventory listed in it.  I am needing to create a report that summarizes all of a department's inventory.  I would then like to export this report to different Excel workbooks saved as the department name so it can be emailed to the department head.

I'm stumped on how to begin this...  Will I need to begin with a query or do it all in VBA with a loop procedure checking for a change in department ?  I consider myself fluent on the Excel side of VBA but I'm hoping to do this all in Access with programming.  I'm also hoping I can get some help on beginning the VBA code in Access since it's a little different than Excel.

This is kind of the format I would like to use where the data enclosed in brackets are fields in my database:

For each department, write a report in this format (naming the workbook with the department name):
Header: <Department Name>'s Inventory - Bold/Large Font
<Department Head Name> - Medium Font
Column Names - Bold/Underlined/Color Shaded
All Inventory listed in tabular format - Plain text

As you can see, it's a fairly simple style.  I will probably dress up the report by programming the font/shading changes.
Who is Participating?
LucasMS Dynamics DeveloperCommented:
Let me know what the table names are, and column names.  I can do this for you fairly quickly.  Check my profile for email.
nmoore82Author Commented:
Table: FixedAssets
Columns: TagNumber
nmoore82Author Commented:
Lucas911's response:

Option Compare Database
Option Explicit

Private Sub cmdGenerate_Click()
'recordset declaration
Dim rs As DAO.Recordset

'open the recordset to get all distinct departments
Set rs = CurrentDb.OpenRecordset("select distinct deptassign from fixedassets")

'check for records
If rs.EOF Then
    MsgBox "There are no assigned departments."
    Exit Sub
'loop through each department, call another sub routine  and create the excel file
    Do Until rs.EOF
        'Call up CreateExcelFile sub and pass over the deparment name
        If Not IsNull(rs!DeptAssign) Then
            CreateExcelFile rs!DeptAssign
        End If

End If

Set rs = Nothing
End Sub

Private Sub CreateExcelFile(sDept As String)
'Excel declarations:  You have to have the Microsoft Excel Object Library XX in order for this to work
'Otherwise you can use objects instead which will work with every excel version

Dim myExcel As Excel.Application 'Our excel app
Dim myWkb As Excel.Workbook     'Our workbook
Dim mySht As Excel.Worksheet    'Our worksheet
Dim rs As DAO.Recordset             'Recordset
Dim row As Long, col As Long    'rows and columns so we can keep track

'Open a recordset for the department in question given by sDept
Set rs = CurrentDb.OpenRecordset("select * from fixedassets where deptassign = '" & sDept & "'")

'again check if there are any records
If rs.EOF Then Exit Sub

'New excel application needs to be declared in memory.
Set myExcel = New Excel.Application

'This only makes it visible to the user
myExcel.Visible = True

'Create new workbook for our excel application
Set myWkb = myExcel.Workbooks.Add

'Activate our workbook...
Set myWkb = myExcel.ActiveWorkbook

'assign our new worksheet variable so that it points to our activated workbook's worksheet
Set mySht = myWkb.ActiveSheet

'Doing some formatting to our worksheet
mySht.Range("A1:e1").Merge              'Merging a few columns to fit department name
mySht.Range("A1").Font.Size = 20       'Changing the font size
mySht.Range("a1") = sDept & "'s Inventory"      'The name of the department goes here
mySht.Range("a2").Font.Size = 14        'Moving on to the new heading and changing our font size
mySht.Range("a2:e2").Merge                 'Merging it so it matches the deparment
mySht.Range("a2") = rs!PersonAssign     'And putting in the department head name

'This sub routine creates our headings:
'mySht = our worksheet
'1 = column where to start
'4 = row where to start
CreateColumnHeadings mySht, 1, 4

'for tracking purposes to export the data:
'col = column # to begin exporting the data
'row = row # to begin exporting the data from
col = 1
row = 5

'looping through the recordset for the department
Do Until rs.EOF
    'This loop, loops through each record and exports it in the cells
    'col = col +1 moves to the next column
    With mySht
        .Cells(row, col) = rs!TagNumber
        col = col + 1
        .Cells(row, col) = rs!ReferenceNum
        col = col + 1
        .Cells(row, col) = rs!InventoryID
        col = col + 1
        .Cells(row, col) = rs!FisYear
        col = col + 1
        .Cells(row, col) = rs!CurrentCC
        col = col + 1
        .Cells(row, col) = rs!PersonAssign
        col = col + 1
        .Cells(row, col) = rs!TechnologyFlag
        col = col + 1
        .Cells(row, col) = rs!POVendor
        col = col + 1
        .Cells(row, col) = rs!ItemName
        col = col + 1
        .Cells(row, col) = rs!Category
        col = col + 1
        .Cells(row, col) = rs!SubItem
        col = col + 1
        .Cells(row, col) = rs!TypeSize
        col = col + 1
        .Cells(row, col) = rs!Manufacturer
        col = col + 1
        .Cells(row, col) = rs!ModelPart
        col = col + 1
        .Cells(row, col) = rs!Detail
        col = col + 1
        .Cells(row, col) = rs!Serial_Num
        col = col + 1
        .Cells(row, col) = rs!DeptAssign
        col = col + 1
        .Cells(row, col) = rs!Building
        col = col + 1
        .Cells(row, col) = rs!Room
        col = col + 1
        .Cells(row, col) = rs!Campus
        col = col + 1
        .Cells(row, col) = rs!PONum
        col = col + 1
        .Cells(row, col) = rs!PODate
        col = col + 1
        .Cells(row, col) = rs!Price
        col = col + 1
        .Cells(row, col) = rs!CheckDate
        col = col + 1
        .Cells(row, col) = rs!Deleted
        col = col + 1
        .Cells(row, col) = rs!DeletedDate
        row = row + 1 'move over to the next row
        col = 1 'reset the column
    End With

'save the workbook in a folder
myWkb.SaveAs "c:\DeptExcel\" & sDept & ".xls"

'quit excel

Set myExcel = Nothing
Set myWkb = Nothing
Set mySht = Nothing

Set rs = Nothing
End Sub

Private Sub CreateColumnHeadings(mSht As Worksheet, lcol As Long, lRow As Long)
'This sub reads the column headings from the table
'This can be modified to read column headings from a query if you wish, so
'that you can customize your headings

Dim tblDef As TableDef
Dim tblFld As Field

For Each tblDef In CurrentDb.TableDefs
   If tblDef.Name = "FixedAssets" Then
        For Each tblFld In tblDef.Fields
            With mSht
                .Cells(lRow, lcol).RowHeight = 24
                .Cells(lRow, lcol) = tblFld.Name
                .Cells(lRow, lcol).ColumnWidth = 14
                .Cells(lRow, lcol).Interior.ColorIndex = 15
                .Cells(lRow, lcol).Interior.Pattern = xlSolid
                .Cells(lRow, lcol).Font.Underline = xlUnderlineStyleSingle
                .Cells(lRow, lcol).Font.Bold = True
                .Cells.HorizontalAlignment = xlCenter
                lcol = lcol + 1
            End With
        Next tblFld
    End If
Next tblDef

End Sub

Perfect, just what I needed, thank you!
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.