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?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

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.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
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!
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.