Export Access Report to Excel - Different Workbooks

Posted on 2006-04-27
Last Modified: 2012-08-13
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.
Question by:nmoore82
    LVL 13

    Accepted Solution

    Let me know what the table names are, and column names.  I can do this for you fairly quickly.  Check my profile for email.

    Author Comment

    Table: FixedAssets
    Columns: TagNumber

    Author Comment

    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!

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Suggested Solutions

    Title # Comments Views Activity
    Dlookup and where condition 3 18
    Sql code problem 6 12
    Access 2003, modify export spec 11 14
    dcount multiple criteria 19 22
    Introduction The Visual Basic for Applications (VBA) language is at the heart of every application that you write. It is your key to taking Access beyond the world of wizards into a world where anything is possible. This article introduces you to…
    In a multiple monitor setup, if you don't want to use AutoCenter to position your popup forms, you have a problem: where will they appear?  Sometimes you may have an additional problem: where the devil did they go?  If you last had a popup form open…
    Familiarize people with the process of utilizing SQL Server views from within Microsoft Access. Microsoft Access is a very powerful client/server development tool. One of the SQL Server objects that you can interact with from within Microsoft Access…
    In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.

    737 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    20 Experts available now in Live!

    Get 1:1 Help Now