Izvoz informacija iz Microsoft Access-a je neverovatno jednostavan – pod pretpostavkom da želite da napravite samo jednu datoteku za izvoz. Ali šta radite kada trebate podijeliti upit (ili tabelu) na više datoteka za izvoz? Na primjer, ako treba da izvezete listu transakcija klijenata svakog mjeseca – svaki klijent ima svoju datoteku za izvoz? Tu vam ovaj članak može pomoći. Izrada izvoza od 2, 10 ili stotinu različitih eksporta će biti jednostavna kao pokretanje malog VBA isječka koda i posao će biti gotov za nekoliko sekundi, a ne satima ručnog rezanja/ljepljenja. Pa da počnemo…
Pristup
Budući da želimo da ovo bude što fleksibilnije i upotrebljivije, kod za ovaj članak će biti malo duži nego inače, ali uskoro ćete vidjeti zašto.
Prvo – hajde da navedemo šta želimo da postignemo:
Dati upit, izbacite novu datoteku svaki put kada se promijeni vrijednost u navedenom polju.
Izazov
Da bismo to uradili, moramo biti u mogućnosti da pregledamo rezultate upita, upoređujući relevantno polje u trenutnom redu sa vrednošću u prethodnom redu – i ako se razlikuju, kreiramo novu datoteku i počnemo da ispisujemo rezultate upita tamo.
Za šta ovo NIJE pogodno
Kao što sam već spomenuo – postoji mnogo razloga zašto biste željeli da izvezete dijelove svoje baze podataka, ali korištenje kao oblika sigurnosne kopije/arhiviranja nije jedan od njih – svakako ne s pristupom koji ja koristim koristeći ovdje – posljednja stvar koju želite da uradite ako ste suočeni sa oporavkom od a korumpirana mdb baza podataka radi kako da spoji mnogo izvoza!
Rjesenje?
Uvijek postoji mnogo načina da se odere mačka, ovaj način je samo jedan - ali mislim da prilično dobro funkcionira. Prvo ćemo pročitati upit u niz kako bismo olakšali kretanje. Zatim ćemo proći kroz taj niz petljom, provjeravajući jesmo li pronašli novu vrijednost u relevantnom polju ili ne. Ako nije nova vrijednost, ispisujemo cijeli zapis u trenutnu datoteku koju pišemo, ako je nova, zatvorit ćemo tu datoteku i započeti novu.
A kod…
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
Šta kod radi – ključne tačke
Dodao sam komentare kodu na većini ključnih mjesta, ali ipak postoji nekoliko stvari koje vrijedi istaknuti.
Prvo – podijelili smo kod u dvije rutine. Prvi provjerava da li trenutni zapis treba biti upisan u istu datoteku na kojoj trenutno radimo ili treba biti upisan u novu datoteku. Druga rutina daje detalje za cijeli zapis u datoteku. To je urađeno na ovaj način da se smanji dupliranje u kodu, inače biste vidjeli da se ista petlja dešava na mnogim mjestima.
Drugo – koristim “Definiciju upita” da dobijem detalje o upitu protiv kojeg radimo – ako želite da možete ovo prilagoditi za rad sa tabelama, pogledali biste to zamijeniti tako da koristi “ Definicija tabele”.
Uz to, prilično sam uvjeren da je ovo dio koda na koji ćete se vraćati i često ga koristiti!
Uvod za autora:
Mitchell Pond je stručnjak za oporavak podataka DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući Popravak SQL Server podaci i Excel softverski proizvodi za oporavak. Za više informacija posjetite www.datanumen.com