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.

[code=vb]
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.OpenRecord set("MainTable" , dbOpenSnapshot)
Set MyLt = MyDB.OpenRecord set("List", dbOpenSnapshot)

Do While Not MyLt.EOF
MyRS.FindFirst ("[EmpID]='" & MyLt!EmpID & "'")
Set MyEx = MyDB.OpenRecord set("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.TransferS preadsheet acExport, acSpreadsheetTy peExcel5, "ExportTBL" , "C:\" & MyLt!EmpID, True
DoCmd.SetWarnin gs False
DoCmd.RunSQL "DELETE * FROM ExportTBL", False
DoCmd.SetWarnin gs True
MyLt.MoveNext
Loop
[/code]

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 TransferSpreads heet 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.TransferS preadsheet 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.