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, să creăm un fișier nou și să începem să afișăm 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 modalități de a jupui o pisică, aceasta este doar una - dar cred că funcționează destul de bine. Mai întâi vom citi interogarea într-un array pentru a facilita navigarea. Apoi vom parcurge acel array, verificând dacă am găsit o valoare nouă în câmpul relevant sau nu. Dacă nu este o valoare nouă, vom afișa întreaga înregistrare în fișierul curent pe care îl scriem, dacă este nouă, vom închide acel fișier și vom începe 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, 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
Ce face codul - puncte cheie
Am adăugat comentarii la cod în majoritatea locurilor cheie, dar mai sunt câteva lucruri care merită evidențiate.
Î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