Det er utrolig enkelt å eksportere informasjon fra Microsoft Access - forutsatt at du bare vil produsere en enkelt eksportfil. Men hva gjør du når du trenger å dele en spørring (eller tabell) i flere eksportfiler? Hvis du for eksempel trenger å eksportere en liste over kundetransaksjoner hver måned – har hver kunde sin egen eksportfil? Det er der denne artikkelen kan hjelpe deg. Å produsere en eksport av 2, 10 eller hundre forskjellige eksporter vil være like enkelt som å kjøre en liten VBA-kodebit, og jobben vil være ferdig på sekunder, ikke timer med manuelt klipping/liming. Så la oss begynne...
Tilnærmingen
Fordi vi ønsker at dette skal være så fleksibelt og brukbart som mulig, kommer koden for denne artikkelen til å være litt lengre enn vanlig, men du vil snart se hvorfor.
Først – la oss skissere hva vi ønsker å kunne oppnå:
Gitt en spørring, skriv ut en ny fil hver gang en verdi i et spesifisert felt endres.
Utfordringen
For å gjøre dette må vi kunne gå gjennom resultatene av spørringen, sammenligne det relevante feltet i gjeldende rad med verdien i forrige rad – og hvis de er forskjellige, opprette en ny fil og begynne å skrive ut spørreresultatene der.
Hva dette IKKE egner seg til
Som jeg allerede har nevnt - det er mange grunner til at du ønsker å eksportere deler av databasen din, men å bruke den som en form for sikkerhetskopiering/arkivformål er ikke en av dem - absolutt ikke med den tilnærmingen jeg er bruker her – det siste du vil gjøre hvis du står overfor å komme deg etter en korrupt mdb-database jobber med å sy massevis av eksport sammen igjen!
Løsningen?
Det finnes alltid mange måter å flå en katt på, denne måten er bare én – men en som fungerer ganske bra, tror jeg. Først leser vi spørringen inn i en array for å gjøre det enklere å navigere. Deretter går vi gjennom arrayet i løkke og sjekker om vi har funnet en ny verdi i det relevante feltet eller ikke. Hvis det ikke er en ny verdi, sender vi ut hele posten til den gjeldende filen 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
Hva koden gjør – nøkkelpunkter
Jeg har lagt til kommentarer i koden på de fleste viktige steder, men det er fortsatt et par ting som er verdt å fremheve.
Først – vi har delt koden i to rutiner. Den første sjekker om gjeldende post skal skrives til den samme filen vi jobber med, eller om den skal skrives til en ny fil. Den andre rutinen sender ut detaljene for hele posten til filen. Det har blitt gjort på denne måten for å kutte ned på duplisering i koden, ellers vil du se den samme loopingen finne sted mange steder.
For det andre – jeg bruker «Query Definition» for å få detaljer om spørringen vi jobber mot – hvis du ønsker å kunne tilpasse dette til å fungere med tabeller, kan du se på å bytte det slik at det brukte « Tabelldefinisjon» i stedet.
Når det er sagt, er jeg ganske sikker på at dette er litt kode du vil referere tilbake til og bruke mye av!
Forfatterintroduksjon:
Mitchell Pond er en datagjenopprettingsekspert innen DataNumen, Inc., som er verdensledende innen datagjenopprettingsteknologier, inkludert reparasjon SQL Server dato og excel-programvareprodukter for gjenoppretting. For mer informasjon besøk www.datanumen. Med