Het exporteren van informatie uit Microsoft Access is ongelooflijk eenvoudig - ervan uitgaande dat u maar één exportbestand wilt maken. Maar wat doet u als u een query (of tabel) moet opsplitsen in meerdere exportbestanden? Als u bijvoorbeeld elke maand een lijst met klantentransacties moet exporteren - heeft elke klant zijn eigen exportbestand? Dat is waar dit artikel je kan helpen. Het maken van een export van 2, 10 of honderd verschillende exportbestanden is net zo eenvoudig als het uitvoeren van een klein VBA-codefragment en de taak is binnen enkele seconden klaar, geen uren handmatig knippen / plakken. Dus laten we beginnen ...
De aanpak
Omdat we willen dat dit zo flexibel en bruikbaar mogelijk is, wordt de code voor dit artikel iets langer dan normaal, maar u zult binnenkort zien waarom.
Laten we eerst even schetsen wat we willen bereiken:
Gegeven een query, voer dan een nieuw bestand uit telkens wanneer een waarde in een gespecificeerd veld verandert.
De uitdaging
Om dit te kunnen doen, moeten we de resultaten van de query stap voor stap kunnen doorlopen en het relevante veld in de huidige rij vergelijken met de waarde in de vorige rij. Als ze verschillen, moeten we een nieuw bestand aanmaken en de queryresultaten daarin opslaan.
Waar dit NIET voor geschikt is
Zoals ik al zei - er zijn tal van redenen waarom je delen van je database zou willen exporteren, maar het gebruiken als een vorm van back-up / archiefdoeleinden is daar niet een van - zeker niet met de aanpak die ik ben hier gebruiken - het laatste dat u wilt doen als u wordt geconfronteerd met het herstellen van een corrupte mdb-database werkt aan het samenvoegen van veel exportproducten!
De oplossing?
Er zijn altijd meerdere manieren om een kat te villen, dit is er slechts één – maar wel eentje die volgens mij prima werkt. Eerst lezen we de query in een array om het navigeren erdoorheen te vergemakkelijken. Vervolgens doorlopen we die array en controleren we of we een nieuwe waarde in het betreffende veld hebben gevonden. Als het geen nieuwe waarde is, schrijven we het hele record naar het bestand waaraan we momenteel werken. Als het wel een nieuwe waarde is, sluiten we dat bestand en starten we een nieuw bestand.
En de 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
Wat de code doet - belangrijkste punten
Ik heb op de meeste belangrijke plekken commentaar aan de code toegevoegd, maar er zijn nog een paar dingen die het waard zijn om te benadrukken.
Ten eerste hebben we de code opgesplitst in twee routines. De eerste controleert of het huidige record moet worden geschreven naar hetzelfde bestand waar we momenteel aan werken, of dat het moet worden geschreven naar een nieuw bestand. De tweede routine voert de details voor het hele record naar het bestand uit. Het is op deze manier gedaan om duplicatie in de code te verminderen, anders zou je op veel plaatsen dezelfde looping zien plaatsvinden.
Ten tweede - ik gebruik de "Querydefinitie" om details te krijgen over de query waar we tegen werken - als je deze wilt kunnen aanpassen om met tabellen te werken, zou je kijken hoe je dat kunt omwisselen zodat het de " Tabeldefinitie ”.
Dat gezegd hebbende, ik ben er vrij zeker van dat dit een stukje code is waar je naar zult verwijzen en die je veel zult gebruiken!
Auteur Introductie:
Mitchell Pond is een expert op het gebied van gegevensherstel in DataNumen, Inc., de wereldleider in technologieën voor gegevensherstel, waaronder reparatie SQL Server gegevens en Excel-herstelsoftwareproducten. Voor meer informatie bezoek www.datanumen.com