Izvoz informacija iz programa Microsoft Access nevjerojatno je jednostavan – pod pretpostavkom da želite proizvesti samo jednu datoteku za izvoz. Ali što učiniti kada trebate podijeliti upit (ili tablicu) u više izvoznih datoteka? Na primjer, ako trebate izvesti popis transakcija kupaca svaki mjesec - svaki kupac ima svoju datoteku za izvoz? Tu vam ovaj članak može pomoći. Izrada izvoza od 2, 10 ili stotinu različitih izvoza bit će jednostavna poput pokretanja malog isječka VBA koda i posao će biti dovršen za nekoliko sekundi, a ne satima ručnog rezanja/lijepljenja. Pa počnimo…
Pristup
Budući da želimo da ovo bude što je moguće fleksibilnije i upotrebljivije, kôd za ovaj članak bit će malo duži nego inače, ali uskoro ćete vidjeti zašto.
Prvo – naznačimo što želimo postići:
S obzirom na upit, ispišite novu datoteku svaki put kada se promijeni vrijednost u određenom polju.
Izazov
Da bismo to učinili, moramo biti u mogućnosti proći kroz rezultate upita, uspoređujući relevantno polje u trenutnom retku s vrijednošću u prethodnom retku – i ako se razlikuju, stvoriti novu datoteku i tamo početi ispisivati rezultate upita.
Za što ovo NIJE prikladno
Kao što sam već spomenuo – postoji mnogo razloga zašto biste željeli izvesti dijelove svoje baze podataka, ali korištenje iste kao oblika sigurnosne kopije/arhiviranja nije jedan od njih – svakako ne s pristupom koji ja imam korištenje ovdje – posljednja stvar koju želite učiniti ako se suočite s oporavkom od a oštećena mdb baza podataka radi na tome kako ponovno spojiti puno izvoza!
Rješenje?
Uvijek postoji mnogo načina za odiranje mačke, ovaj način je samo jedan - ali mislim da prilično dobro funkcionira. Prvo ćemo upit pročitati 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, cijeli zapis ispisujemo u trenutnu datoteku koju pišemo, ako je nova, zatvorit ćemo tu datoteku i pokrenuti novu.
A šifra…
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
Što kod radi – ključne točke
Dodao sam komentare u kod na većini ključnih mjesta, ali još uvijek postoji nekoliko stvari koje vrijedi istaknuti.
Prvo – podijelili smo kod u dvije rutine. Prvo provjerava treba li trenutni zapis zapisati u istu datoteku na kojoj trenutno radimo ili treba zapisati u novu datoteku. Druga rutina ispisuje pojedinosti za cijeli zapis u datoteku. Učinjeno je na ovaj način kako bi se smanjilo dupliciranje u kodu, inače biste vidjeli da se isto ponavljanje događa na mnogim mjestima.
Drugo – koristim “Definiciju upita” da dobijem pojedinosti o upitu na kojem radimo – ako želite ovo moći prilagoditi za rad s tablicama, trebali biste to zamijeniti tako da koristi “ Definicija tablice”.
Uz to rečeno, 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 u DataNumen, Inc., koji je svjetski lider u tehnologijama za oporavak podataka, uključujući popravak SQL Server datum i excel softverski proizvodi za oporavak. Za više informacija posjetite www.datanumen.com