How to Export the Results of a Query to Multiple Files with Access VBA

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

Export A Query In AccessIn 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

Access VBAI’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

Comments are closed.