How to split by the value of a field and copy to respectively exce

  • Thread starter Thread starter Dawn
  • Start date Start date
D

Dawn

There is a table tbl1,with several fields, one of them is City, with the
value varies from city1 to city30.
I want to use Access Marco to automatically using function
transferspreadsheet to copy this tbl1 into 30 excel sheets, by the value of
city. For eg, select * from tbl1 where city value=city1 , then put the
selected records into excel file “\…\…\city1.xlsâ€,
Thus generates 30 excel files.
Is there a simple way to achieve this, avoid writing 30
transferspreadsheets in a macro?
Thanks.
Dawn
 
I'm not sure that you can do this with a macro (it would take a while to
design and try), but it can be done fairly easily using VBA code.(I've
already written such code). Is VBA an acceptable approach?
 
Ken,
Any help on this problem is appreciated.But as I am a new comer of Access,
if possible ,can you simple introduce how to use your VBA code, like start
from which moudle of MS Access.
Very very thanks.
 
Ken,
Can you share your VBA Codes?
Thanks

Ken Snell (MVP) said:
I'm not sure that you can do this with a macro (it would take a while to
design and try), but it can be done fairly easily using VBA code.(I've
already written such code). Is VBA an acceptable approach?
 
Yes, I will. I am traveling on business right now, so I will post a little
later this week. Sorry for the delay.
 
I've modified some code (from my library) to what I believe will work for
your table name and field name information. But, it's possible that some
tweaking might be needed to "debug" the code, so feel free to post back with
questions/problems.

I've written this as a function, so put this code in a new Module object (do
not name the module the same name as the function). You then can call this
subroutine from another VBA procedure or from a macro or from an actual
event of a control on a form. If you post back with more information about
the context in which you want to run this export process, I can provide
additional suggestions for how to set it up.



Customized code to create a temporary query, get list of
filtering values, and then loop through the list to filter
various data and export each filtered query to separate
worksheets in a single EXCEL file
----------------------------------------------------------

'Start of code
Public Sub ExportCityQueries()
Dim qdf As DAO.QueryDef
Dim dbs As DAO.Database
Dim rstMgr As DAO.Recordset
Dim strSQL As String, strTemp As String, strMgr As String

Const strFileName As String = "PutEXCELFileNameHereWithout.xls"
Const strQName As String = "zExportQuery"

Set dbs = CurrentDb

' Create temporary query that will be used for exporting data;
' give it a dummy SQL statement initially
strTemp = dbs.TableDefs(0).Name
strSQL = "SELECT * FROM [" & strTemp & "] WHERE 1=0;"
Set qdf = dbs.CreateQueryDef(strQName, strSQL)
qdf.Close
strTemp = strQName

' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
' Get list of City values
strSQL = "SELECT DISTINCT City FROM tbl1;"
Set rstMgr = dbs.OpenRecordset(strSQL, dbOpenDynaset, dbReadOnly)

' Now loop through list of city values and create a query for each value
' so that the data can be exported
If rstMgr.EOF = False And rstMgr.BOF = False Then
rstMgr.MoveFirst
Do While rstMgr.EOF = False
' *** code to set strSQL needs to be changed to conform to your
' *** database design -- ManagerID, EmployeesTable need to
' *** be changed to your table and field names
strSQL = "SELECT * FROM tbl1 WHERE " & _
"City = '" & rstMgr!ManagerID.Value & "';"
Set qdf = dbs.QueryDefs(strTemp)
qdf.Name = "q_" & strMgr
strTemp = qdf.Name
qdf.SQL = strSQL
qdf.Close
Set qdf = Nothing
' Replace C:\FolderName\ with actual path
DoCmd.TranferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
strTemp, "C:\FolderName\" & strFileName & ".xls"
rstMgr.MoveNext
Loop
End If

rstMgr.Close
Set rstMgr = Nothing

dbs.QueryDefs.Delete strTemp
dbs.Close
Set dbs = Nothing
End Sub
'End of code
 
Back
Top