Hvordan eksportere resultatene av en spørring til flere filer med Access VBA

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 være i stand til å 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 start sende ut søkeresultatene 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 er alltid mange måter å flå en katt på, denne måten er bare én – men en som fungerer ganske bra synes jeg. Først leser vi søket inn i en matrise for å gjøre det enklere å flytte rundt. Deretter går vi gjennom den matrisen, 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, hvis den er ny, lukker vi den filen ogtaren 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 Long numrows, loopcount As Dim data, fs, fwriter As Variant Dim fldnames(), headerString As String 'få detaljer om spørringen vi skal eksportere Set objRecordset = New ADODB.Recordset Set db = CurrentDb Set qdf = db.QueryDefs(queryName) 'last inn spørre inn i et postsett slik at vi kan jobbe med det objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly 'last postsettet inn i en array data = objRecordset.GetRows 'lukk rekordsettet som vi er ferdig med det nå objRecordset. Lukk 'få detaljer om størrelsen på matrisen og posisjonen til feltet vi ser etter i den matrisen colno = qdf.Fields(fieldName).OrdinalPosition numrows = UBound(data, 2) numcols = UBound(data, 1) ' ettersom vi må skrive ut en overskrift for hver fil - få feltnavnene for den overskriften 'og konstruer en overskriftsstreng ReDim fldnames(numcols) For fldcounter = 0 Til qdf.Fields.Count - 1 fldnames(fldcounter) = qdf .Fields(fldcounter).Name Next headerString = Join(fldnames, delim) 'forbered filskriptgrensesnittet slik at vi kan opprette og skrive til filen(e) våre. Sett fs = CreateObject("Scripting.FileSystemObject") 'sløyfe gjennom arrayen vår og utdata til filen 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 (filPath & data(colno, loopcount) & ".txt", True) fwriter.writeline headerString writetoFile data, queryName, fwriter, loopcount, numcols Else writetoFile data, delim, fwriter, loopcount, numcols End If Else Sett fwriter = fs. createTextfile(filePath & data(colno, loopcount) & ".txt", True) fwriter.writeline headerString writetoFile data, delim, fwriter, loopcount, numcols End If Next 'rydde opp etter oss fwriter.Close Set fwriter = Nothing Set objRecordset = Ingenting Set db = Ingenting Set qdf = Ingenting End Sub 'parametere sendes "ved referanse" for å hindre å flytte potensielt store objekter rundt i minnet 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 til koden i most 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