Exporting to multiple spreadsheets

[jkwok]

Hi,

I have a spreadsheet which I've imported into one table, 'Assets', in Access. In the table, I have to separate the data based on one attribute: 'empID'. empID is the employee ID and can occur in multiple rows, so it's not the primary key.

What I need to do is this:

1. go through the entire Assets table and produce a spreadsheet for each empID. So for each unique empID, a spreadsheet will be made containing all the data related in that record. If an empID has more than one entry in the table, it will be included on a new line in the spreadsheet.

ex.

Assets
empID --- country --- name
eR123 --- Canada --- Jason
eN432 --- China --- Clifford
eR123 --- Canada --- Jason
eU543 --- Mexico --- Alex

This would give 3 new spreadsheets names eR123.xls with 2 rows, eN432.xls and eU543.xls both with 1 row each.

2. These speadsheets have to be named based on their empID. So all spreadsheet for empID 'eR123' would be named 'eR123.xls'. I have a template spreadsheet that can be used, but I'm not sure how to name them dynamically using VB or macros. I have several thousand records to process so doing this manually isn't an option.

Any help or direction would be very much appreciated!!

Thanks,
Jason

[PianoMan64]

Well, you're going to need some help with setting some things up.

I've included an example of what you're going to need to do, but I will explaine it for you, of what I've done.

I'm assuming you already have a table that has all these items in it. You will need to get a list of all the field names that you're going to be using and include those in the code example that I've sent along.

You will need to setup a Export table called ExportTBL.
Add all the fields that you want to export.
Then you will need to create a group query by pasting the following code into the SQL view of a query.

SELECT EmpID from [Table Name of All Entries] GROUP BY EmpID
 

Once you done that create a blank form that is not bound to any table or query.

Then create a button by click on command button in toolbar and drawing a command button. Name the command button whatever you'd like it to be.

Then on the OnClick Event, paste the following code into the form.

Dim MyDB As DAO.Database
Dim MyRS As DAO.Recordset
Dim MyLt As DAO.Recordset
Dim MyEx As DAO.Recordset
Dim CurrentRS As DAO.Recordset
 
Set MyDB = CurrentDb()
Set MyRS = MyDB.OpenRecordset("MainTable", dbOpenSnapshot)
Set MyLt = MyDB.OpenRecordset("List", dbOpenSnapshot)
 
Do While Not MyLt.EOF
MyRS.FindFirst ("[EmpID]='" & MyLt!EmpID & "'")
Set MyEx = MyDB.OpenRecordset("ExportTBL", dbOpenDynaset)
If Not MyRS.NoMatch Then
Do While Not MyRS.EOF
MyEx.AddNew
MyEx!EmpID = MyRS!EmpID
MyEx!Country = MyRS!Country
MyEx!UserName = MyRS!UserName
MyEx.Update
MyRS.FindNext ("[EmpID]='" & MyLt!EmpID & "'")
If MyRS.NoMatch Then Exit Do
Loop
End If
MyEx.Close
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel5, "ExportTBL", "C:\" & MyLt!EmpID, True
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE * FROM ExportTBL", False
DoCmd.SetWarnings True
MyLt.MoveNext
Loop
 

PLEASE MAKE SURE THAT YOU REFERENCE THE DAO LIBRARY ON YOUR SYSTEM. you get there by going into the Visual Basic Editor, Then clicking on Tools, Reference, and then Locate Microsoft DAO 3.x version that you have installed on your computer.

That should do what you need to do. If you have any questions, I've attached the database to the reponse if you have any formating or syntax questions.

Hope that helps,

Joe P.

[jkwok]

Hi Joe P,

This looks amazing! I really appreciate all the time and effort you put into helping me out! I'll try this and let you know how it turns out.

Thanks again!

Jason

[jkwok]

Hey PianoMan64,

Your code worked perfectly. I was able to create all 1800 spreadsheets and they were are properly named! Thank you very much!

I have one more issue though. When the spreadsheets are created, is there anyway to have them use a template I have? The person who will be using this has a preset format she has to use, along with a few macros, and has made a template for it.

It's currently named assets.xlt. I was looking at the TransferSpreadsheet method and I didn't see an argument for a template to be included. I believe there is one in the OutputTo method, however I don't know if that would work the way I need it to.

So, using the code already layed out for me by PianoMan64, can anyone think of a way to include the use of this Excel template I have?

Thanks,
Jason

[jkwok]

If it's of any help, I'm using Access and Excel 2003. I've been searching the msdn site but haven't found much of anything relevant, but it must be possible to export to a template right? :D

Thanks again,
Jason

[Stewart Ross]

Well, no I'm sorry to say. I guess not too many people actually use Excel templates. However, using VBA and Excel automation the attached two subroutines can replace the DoCmd.TransferSpreadsheet method call in Joe's code, allowing you to specify the template filename as the input file

Usage:
Replace the Docmd line with

TransferSpreadsheet TableorQueryName, templatename, outputfilename

Include the full path in the filenames.

'This replacement for DoCmd.TransferSpreadsheet provides ability to specify the
'input Excel file to transfer query or table data from Access
'An Excel template file can be used as the input filename if required
'All filenames should be specified as full paths.
'
'To use these please ensure that there are references to
'the DAO and Excel object libraries in the VB environment
'- select Tools, References and ensure that
'Microsoft DAO 3.6 Object Library (or later) is ticked, and the
'Microsoft Excel 11 Object Library (or later)
'
Public Sub TransferSpreadsheet(ByVal Tablename As String, Optional ByVal InputxlFilename As String = "", Optional ByVal ExportxlFileName As String = "")
    On Error GoTo Err_Handler
    Dim objExcel As Excel.Application
    Dim TheFilename As String
    Set objExcel = New Excel.Application
    If InputxlFilename = "" Then
        objExcel.Workbooks.Add
    Else
        objExcel.Workbooks.Open (InputxlFilename)
    End If
    TransferQueryData Tablename, objExcel
    If ExportxlFileName = "" Then
        TheFilename = objExcel.Application.GetSaveAsFilename(, "Excel WorkBook (*.xls), .xls")
    Else
        TheFilename = ExportxlFileName
    End If
    objExcel.DisplayAlerts = False
    objExcel.ActiveWorkbook.SaveAs FileName:=TheFilename
    objExcel.DisplayAlerts = True
    objExcel.Quit
    Set objExcel = Nothing
    Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation, "Error " & Err.Number
End Sub
 
Private Sub TransferQueryData(ByVal QueryName As String, ByRef objExcel As Excel.Application)
    Dim TheQuery As DAO.Recordset, DataCopied As Boolean
    Dim N As Integer, R As Long, i As Integer
    If Len(QueryName) = 0 Then
        MsgBox "No query name supplied - data not transferred", vbCritical
        Exit Sub
    End If
    On Error GoTo Err_Handler
    Set TheQuery = CurrentDb.OpenRecordset(QueryName)
    If TheQuery.EOF Then
        'no records - exit after closing recordset
        TheQuery.Close
        Exit Sub
    End If
    TheQuery.MoveLast
    R = TheQuery.RecordCount
    TheQuery.MoveFirst
    N = TheQuery.Fields.Count
    'copy query data to second and subsequent rows
    With objExcel.ActiveSheet
        .Cells(2, 1).CopyFromRecordset TheQuery
    End With
    ' transfer field names to first row
    With objExcel.ActiveSheet
        For i = 0 To N - 1
            .Cells(1, i + 1) = TheQuery.Fields(i).Name
        Next i
    End With
    'finished with recordset - close it
    TheQuery.Close
    Exit Sub
Err_Handler:
    MsgBox Err.Description, vbExclamation, "Error " & Err.Number
End Sub

-Stewart

[jkwok]

Hey Stewart,

This worked perfectly. It ran the first time through without a single problem! I can't thank you and PianoMan64 enough for all of your efforts!!!

Thanks again,
Jason

[PianoMan64]

Hey Stewart,

This worked perfectly. It ran the first time through without a single problem! I can't thank you and PianoMan64 enough for all of your efforts!!!

Thanks again,
Jason

Glad we could help.

Joe P.