Cum să exportați rezultatele unei interogări în mai multe fișiere cu Access VBA

Exportul informațiilor din Microsoft Access este incredibil de ușor – presupunând că doriți să produceți doar un singur fișier de export. Dar ce faceți când trebuie să împărțiți o interogare (sau un tabel) în mai multe fișiere de export? De exemplu, dacă trebuie să exportați o listă de tranzacții ale clienților în fiecare lună - fiecare client având propriul fișier de export? Acolo te poate ajuta acest articol. Producerea unui export de 2, 10 sau o sută de exporturi diferite va fi la fel de simplă ca să rulați un mic fragment de cod VBA și lucrarea se va termina în câteva secunde, nu în ore de tăiere/lipire manuală. Asa ca sa incepem…

Apropierea

Pentru că ne dorim ca acest lucru să fie cât mai flexibil și mai utilizabil posibil, codul pentru acest articol va fi puțin mai lung decât de obicei, dar veți vedea de ce în curând.

În primul rând, să subliniem ceea ce dorim să putem realiza:

Având o interogare, scoateți un fișier nou de fiecare dată când se modifică o valoare dintr-un câmp specificat.

Provocarea

Pentru a face acest lucru, trebuie să putem parcurge rezultatele interogării, comparând câmpul relevant din rândul curent cu valoarea din rândul anterior - și dacă sunt diferite, creați un fișier nou și start emite rezultatele interogării acolo.

Pentru ce NU este potrivit

După cum am menționat deja – există o mulțime de motive pentru care ați dori să exportați părți ale bazei de date, dar utilizarea acesteia ca formă de backup/arhivare nu este unul dintre ele – cu siguranță nu cu abordarea pe care o folosesc folosind aici – ultimul lucru pe care vrei să-l faci dacă te confrunți cu recuperarea de la a baza de date mdb coruptă caută cum să îmbine o mulțime de exporturi!

Soluția?

Există întotdeauna o mulțime de moduri de a jupui o pisică, acesta este doar unul – dar unul care funcționează destul de bine cred. În primul rând, vom citi interogarea într-o matrice pentru a face deplasarea mai ușoară. Apoi vom parcurge matricea respectivă, verificând dacă am găsit sau nu o nouă valoare în câmpul relevant. Dacă nu este o valoare nouă, scoatem întreaga înregistrare în fișierul curent pe care îl scriem, dacă este nou, vom închide acel fișier și starta unul nou.

Iar codul...

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, Dim data, fs, fwriter As Variant Dim fldnames(), headerString As String 'obține detalii despre interogarea pe care o vom exporta Set objRecordset = New ADODB.Recordset Set db = CurrentDb Set qdf = db.QueryDefs(queryName) 'încărcați interogați într-un set de înregistrări, astfel încât să putem lucra cu el objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly „încărcați setul de înregistrări într-o matrice data = objRecordset.GetRows „închidem setul de înregistrări așa cum am terminat acum objRecordset. Închideți „obțineți detalii despre dimensiunea matricei și poziția câmpului pe care îl verificăm în acea matrice colno = qdf.Fields(fieldName).OrdinalPosition numrows = UBound(data, 2) numcols = UBound(data, 1)” deoarece va trebui să scriem un antet pentru fiecare fișier - obțineți numele câmpurilor pentru acel antet și construiți un șir de antet ReDim fldnames(numcols) For fldcounter = 0 To qdf.Fields.Count - 1 fldnames(fldcounter) = qdf .Fields(fldcounter).Name Următorul headerString = Join(fldnames, delim) 'pregătește interfața de scriptare a fișierelor, astfel încât să putem crea și scrie în fișierele noastre. și se scoate în fișierul 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 = Nimic End Sub 'parametrii sunt trecuţi „prin referinţă” pentru a preveni mutarea obiectelor potenţial mari în memorie 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 Pentru loopcount = 0 To numcols outstr = outstr & data(loopcount, counter) Dacă loopcount < numcols Then outstr = outstr & delim Next fwriter.writeline outstr End Sub

Ce face codul - puncte cheie

Am adăugat comentarii la codul din most locuri cheie, dar mai sunt câteva lucruri care merită subliniate.

În primul rând, am împărțit codul în două rutine. Prima verifică dacă înregistrarea curentă ar trebui să fie scrisă în același fișier la care lucrăm în prezent sau dacă ar trebui să fie scrisă într-un fișier nou. A doua rutină scoate în fișier detaliile pentru întreaga înregistrare. S-a făcut astfel pentru a reduce duplicarea în cod, altfel veți vedea aceeași buclă care are loc în multe locuri.

În al doilea rând – folosesc „Definiția interogării” pentru a obține detalii despre interogarea cu care lucrăm – dacă doriți să o adaptați pentru a funcționa cu tabele, ați căuta să o schimbați astfel încât să folosească „ Definiția tabelului” în schimb.

Acestea fiind spuse, sunt destul de încrezător că acesta este un pic de cod la care te vei referi și la care te vei folosi foarte mult!

Introducerea autorului:

Mitchell Pond este un expert în recuperarea datelor DataNumen, Inc., care este lider mondial în tehnologiile de recuperare a datelor, inclusiv repara SQL Server de date și produse software de recuperare Excel. Pentru mai multe informații vizitați www.datanumen.com