Eksport af oplysninger fra Microsoft Access er utrolig let - forudsat at du kun vil fremstille en enkelt eksportfil. Men hvad gør du, når du har brug for at opdele en forespørgsel (eller tabel) i flere eksportfiler? For eksempel, hvis du har brug for at eksportere en liste over kundetransaktioner hver måned - hver kunde har sin egen eksportfil? Det er her, denne artikel kan hjælpe dig. At producere en eksport på 2, 10 eller hundrede forskellige eksport vil være så simpelt som at køre et lille VBA-kodestykke, og jobbet bliver færdig på få sekunder, ikke timer med manuel klipning / indsættelse. Så lad os begynde ...
Tilgangen
Fordi vi ønsker, at dette skal være så fleksibelt og anvendeligt som muligt, vil koden til denne artikel være lidt længere end normalt, men du vil snart se, hvorfor.
For det første - lad os skitsere, hvad vi vil være i stand til at opnå:
Ved en forespørgsel skal du udføre en ny fil hver gang en værdi i et bestemt felt ændres.
Udfordringen
For at gøre dette skal vi kunne gennemgå resultaterne af forespørgslen trin for trin, sammenligne det relevante felt i den aktuelle række med værdien i den forrige række – og hvis de er forskellige, skal vi oprette en ny fil og begynde at udskrive forespørgselsresultaterne der.
Hvad dette IKKE er egnet til
Som jeg allerede har nævnt - der er mange grunde til, at du vil eksportere dele af din database, men at bruge det som en form for backup / arkivformål er ikke en af dem - bestemt ikke med den tilgang, jeg er bruger her - den sidste ting, du vil gøre, hvis du står over for at komme sig efter en korrupt mdb-database arbejder på, hvordan man syder en masse eksport sammen igen!
Løsningen?
Der er altid mange måder at flå en kat på, denne måde er kun én – men en der fungerer ret godt, synes jeg. Først læser vi forespørgslen ind i et array for at gøre det nemmere at navigere rundt. Dernæst gennemgår vi arrayet og kontrollerer, om vi har fundet en ny værdi i det relevante felt eller ej. Hvis det ikke er en ny værdi, udskriver vi hele posten til den aktuelle fil, vi skriver til. Hvis den er ny, lukker vi filen og starter en ny.
Og 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
Hvad koden laver - nøglepunkter
Jeg har tilføjet kommentarer til koden de fleste vigtige steder, men der er stadig et par ting, der er værd at fremhæve.
Først - vi har delt koden i to rutiner. Den første kontrollerer, om den aktuelle post skal skrives til den samme fil, som vi i øjeblikket arbejder på, eller om den skal skrives til en ny fil. Den anden rutine udsender detaljerne for hele posten til filen. Det er gjort på denne måde for at skære ned på duplikering i koden, ellers ser du den samme looping finde sted mange steder.
For det andet - Jeg bruger "Query Definition" til at få detaljer om den forespørgsel, vi arbejder imod - hvis du vil være i stand til at tilpasse dette til at arbejde med tabeller, vil du se på at bytte det, så det brugte " Table Definition ”i stedet.
Når det er sagt, er jeg ret sikker på, at dette er en smule kode, du vil henvise til og bruge meget!
Forfatter Introduktion:
Mitchell Pond er en datagendannelsesekspert i DataNumen, Inc., som er verdens førende inden for datagendannelsesteknologier, herunder reparere SQL Server data og excel-genopretningssoftwareprodukter. For mere information besøg www.datanumen.com