Exporting information from Microsoft Access is incredibly easy – assuming you only want to produce a single export file. But what do you do when you need to split a query (or table) into multiple export files? For example, if you need to export a list of customer transactions each month – each customer having their own export file? That’s where this article can help you. Producing an export of 2, 10, or a hundred different exports will be as simple as running a little VBA code snippet and the job will be finished in seconds, not hours of manually cutting/pasting. So let’s begin…
Because we want this to be as flexible and usable as possible, the code for this article is going to be a little longer than usual, but you’ll see why shortly.
Firstly – let’s outline what we want to be able to achieve:
Given a query, output a new file each time a value in a specified field changes.
In order to do this, we need to be able to step through the results of the query, comparing the relevant field in the current row to the value in the previous row – and if they’re different, create a new file and start outputting the query results there.
What this is NOT suitable for
As I’ve already mentioned – there are plenty of reasons why you’d want to export parts of your database, but using it as a form of backup/archive purposes isn’t one of them – certainly not with the approach I’m using here – the last thing you want to do if you’re faced with recovering from a corrupt mdb database is working out how to stitch lots of exports back together!
There are always lots of ways to skin a cat, this way is just one – but one that works pretty well I think. Firstly we’ll read the query into an array to make moving around easier. Next we’ll loop through that array, checking whether we have found a new value in the relevant field or not. If it’s not a new value, we output the entire record to the current file we’re writing, if it is new, we’ll close that file and start a new one.
And the code…
Sub DoExport(fieldName As String, queryName As String, filePath As String, Optional delim As Variant = vbTab) Dim db As Database Dim objRecordset As ADODB.Recordset Dim qdf As QueryDef Dim fldcounter, colno, numcols As Integer Dim numrows, loopcount As Long Dim data, fs, fwriter As Variant Dim fldnames(), headerString As String 'get details of the query we'll be exporting Set objRecordset = New ADODB.Recordset Set db = CurrentDb Set qdf = db.QueryDefs(queryName) 'load the query into a recordset so we can work with it objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly 'load the recordset into an array data = objRecordset.GetRows 'close the recordset as we're done with it now objRecordset.Close 'get details of the size of array, and position of the field we're checking for in that array colno = qdf.Fields(fieldName).OrdinalPosition numrows = UBound(data, 2) numcols = UBound(data, 1) 'as we'll need to write out a header for each file - get the field names for that header 'and construct a header string ReDim fldnames(numcols) For fldcounter = 0 To qdf.Fields.Count - 1 fldnames(fldcounter) = qdf.Fields(fldcounter).Name Next headerString = Join(fldnames, delim) 'prepare the file scripting interface so we can create and write to our file(s) Set fs = CreateObject("Scripting.FileSystemObject") 'loop through our array and output to the file For loopcount = 0 To numrows If loopcount > 0 Then If data(colno, loopcount) <> data(colno, loopcount - 1) Then If Not IsEmpty(fwriter) Then fwriter.Close Set fwriter = fs.createTextfile(filePath & data(colno, loopcount) & ".txt", True) fwriter.writeline headerString writetoFile data, queryName, fwriter, loopcount, numcols Else writetoFile data, delim, fwriter, loopcount, numcols End If Else Set fwriter = fs.createTextfile(filePath & data(colno, loopcount) & ".txt", True) fwriter.writeline headerString writetoFile data, delim, fwriter, loopcount, numcols End If Next 'tidy up after ourselves fwriter.Close Set fwriter = Nothing Set objRecordset = Nothing Set db = Nothing Set qdf = Nothing End Sub 'parameters are passed "by reference" to prevent moving potentially large objects around in memory Sub writetoFile(ByRef data As Variant, ByVal delim As Variant, ByRef fwriter As Variant, ByVal counter As Long, ByVal numcols As Integer) Dim loopcount As Integer Dim outstr As String For loopcount = 0 To numcols outstr = outstr & data(loopcount, counter) If loopcount < numcols Then outstr = outstr & delim Next fwriter.writeline outstr End Sub
What the code is doing – key points
I’ve added comments to the code in most key places, but there’s still a couple of things that are worth highlighting.
First – we’ve split the code into two routines. The first checks whether the current record should be written to the same file we’re currently working on, or whether it should be written to a new file. The second routine outputs the details for the entire record to the file. It’s been done this way to cut down on duplication in the code, otherwise you’d see the same looping taking place in many places.
Second – I’m using the “Query Definition” to get details about the query we’re working against – if you want to be able to adapt this to work with tables, you’d look at swapping that so that it used the “Table Definition” instead.
With that said, I’m pretty confident this is a bit of code you’ll refer back to and use a lot!
Mitchell Pond is a data recovery expert in DataNumen, Inc., which is the world leader in data recovery technologies, including repair SQL Server data and excel recovery software products. For more information visit www.datanumen.com