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…
The approach
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.
The challenge
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!
The solution?
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!
Author Introduction:
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
Leave a Reply