asked on

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.

ASKER CERTIFIED SOLUTION

Lucas

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

nmoore82

ASKER

Table: FixedAssets
Columns: TagNumber
ReferenceNum
InventoryID
FisYear
CurrentCC
PersonAssign
TechnologyFlag
POVendor
ItemName
Category
SubItem
TypeSize
Manufacturer
ModelPart
Detail
Serial_Num
DeptAssign
Building
Room
Campus
PONum
PODate
Price
CheckDate
Deleted
DeletedDate

nmoore82

ASKER

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
Else
'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

rs.MoveNext
Loop
End If

rs.Close
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
rs.MoveNext
Loop

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

'quit excel
myExcel.Quit

'cleanup
Set myExcel = Nothing
Set myWkb = Nothing
Set mySht = Nothing

rs.Close
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!