Exportera information från Microsoft Access är otroligt enkelt - förutsatt att du bara vill skapa en enda exportfil. Men vad gör du när du behöver dela en fråga (eller tabell) i flera exportfiler? Till exempel, om du behöver exportera en lista över kundtransaktioner varje månad - varje kund har sin egen exportfil? Det är där den här artikeln kan hjälpa dig. Att producera en export av 2, 10 eller hundra olika export kommer att vara så enkelt som att köra ett litet VBA-kodavsnitt och jobbet kommer att avslutas på några sekunder, inte timmar med manuell klippning / klistra in. Så låt oss börja ...
Tillvägagångssättet
Eftersom vi vill att detta ska vara så flexibelt och användbart som möjligt kommer koden för den här artikeln att bli lite längre än vanligt, men du kommer att se varför snart.
För det första - låt oss beskriva vad vi vill kunna uppnå:
Med en fråga, mata ut en ny fil varje gång ett värde i ett angivet fält ändras.
Utmaningen
För att göra detta måste vi kunna stega igenom resultaten av frågan, jämföra det relevanta fältet i den aktuella raden med värdet i föregående rad – och om de skiljer sig åt, skapa en ny fil och börja mata ut frågeresultaten där.
Vad detta INTE är lämpligt för
Som jag redan har nämnt - det finns många anledningar till att du vill exportera delar av din databas, men att använda den som en form av säkerhetskopierings- / arkivändamål är inte en av dem - verkligen inte med den metod jag är använder här - det sista du vill göra om du står inför en återhämtning från en korrupt mdb-databas arbetar med att sätta ihop mängder av export tillsammans igen!
Lösningen?
Det finns alltid många sätt att flå en katt, det här sättet är bara ett – men ett som fungerar ganska bra tror jag. Först läser vi in frågan i en array för att göra det enklare att navigera. Sedan loopar vi igenom den arrayen och kontrollerar om vi har hittat ett nytt värde i det relevanta fältet eller inte. Om det inte är ett nytt värde matar vi ut hela posten till den aktuella filen vi skriver, om den är ny stänger vi den filen och börjar på en ny.
Och koden ...
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
Vad koden gör - nyckelpunkter
Jag har lagt till kommentarer i koden på de flesta viktiga ställen, men det finns fortfarande ett par saker som är värda att lyfta fram.
Först - vi har delat koden i två rutiner. Den första kontrollerar om den aktuella posten ska skrivas till samma fil som vi för närvarande arbetar med, eller om den ska skrivas till en ny fil. Den andra rutinen matar ut detaljerna för hela posten till filen. Det har gjorts på detta sätt för att minska duplicering i koden, annars skulle du se samma looping äga rum på många ställen.
För det andra - jag använder "Query Definition" för att få information om frågan vi arbetar mot - om du vill kunna anpassa den till att fungera med tabeller, skulle du titta på att byta den så att den använde " Table Definition ”istället.
Med det sagt är jag ganska säker på att det här är lite kod du kommer att hänvisa till och använda mycket!
Författarintroduktion:
Mitchell Pond är en dataåterställningsexpert i DataNumen, Inc., som är världsledande inom teknik för återställning av data, inklusive reparation SQL Server datum och Excel-programvara för återställningsprogramvara. För mer information besök www.datanumen.com