Eksportuoti informaciją iš „Microsoft Access“ yra neįtikėtinai lengva – darant prielaidą, kad norite sukurti tik vieną eksporto failą. Bet ką daryti, kai reikia padalyti užklausą (arba lentelę) į kelis eksporto failus? Pavyzdžiui, jei kiekvieną mėnesį reikia eksportuoti klientų operacijų sąrašą – kiekvienas klientas turi savo eksporto failą? Štai kur šis straipsnis gali jums padėti. Eksportuoti 2, 10 ar šimtą skirtingų eksportuojamų failų bus taip paprasta, kaip paleisti nedidelį VBA kodo fragmentą ir darbas bus baigtas per kelias sekundes, o ne valandas, kai reikia iškirpti/įklijuoti rankiniu būdu. Taigi pradėkime…
Požiūris
Kadangi norime, kad tai būtų kuo lankstesnė ir patogesnė naudoti, šio straipsnio kodas bus šiek tiek ilgesnis nei įprastai, bet netrukus pamatysite kodėl.
Pirmiausia apibrėžkime, ką norime pasiekti:
Pateikus užklausą, išveskite naują failą kiekvieną kartą, kai pasikeičia nurodyto lauko reikšmė.
Iššūkis
Norėdami tai padaryti, turime galėti peržiūrėti užklausos rezultatus, palygindami atitinkamą dabartinės eilutės lauką su ankstesnės eilutės reikšme, o jei jie skiriasi, sukurti naują failą ir pradėti išvesti užklausos rezultatus ten.
Kam tai NETINKA
Kaip jau minėjau, yra daugybė priežasčių, kodėl norėtumėte eksportuoti savo duomenų bazės dalis, tačiau naudoti ją kaip atsarginės kopijos / archyvavimo tikslais nėra viena iš jų – tikrai ne taikant mano metodą. naudojant čia – paskutinis dalykas, kurį norite padaryti, jei atsigaunate po a sugadinta mdb duomenų bazė svarsto, kaip susieti daug eksporto prekių!
Sprendimas?
Visada yra daug būdų, kaip nulupti katę, šis yra tik vienas iš jų – bet, manau, gana gerai veikiantis. Pirmiausia nuskaitysime užklausą į masyvą, kad būtų lengviau naršyti. Tada cikliškai peržiūrėsime tą masyvą, tikrindami, ar atitinkamame lauke radome naują reikšmę. Jei tai ne nauja reikšmė, visą įrašą išvesime į dabartinį failą, kurį rašome, jei jis naujas, uždarysime tą failą ir pradėsime naują.
Ir kodas…
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
Ką daro kodas – pagrindiniai dalykai
Pridėjau komentarus prie kodo daugumoje svarbiausių vietų, bet vis tiek yra keletas dalykų, kuriuos verta pabrėžti.
Pirma – mes padalijome kodą į dvi įprastas procedūras. Pirmasis patikrina, ar dabartinis įrašas turi būti įrašytas į tą patį failą, su kuriuo šiuo metu dirbame, ar į naują failą. Antroji tvarka į failą išveda viso įrašo detales. Tai buvo padaryta taip, kad būtų sumažintas kodo dubliavimas, kitaip daug kur pamatytumėte tą patį kilpą.
Antra – naudoju „Užklausos apibrėžimą“, kad gaučiau išsamios informacijos apie užklausą, su kuria dirbame – jei norite pritaikyti ją darbui su lentelėmis, turėtumėte pakeisti ją į Lentelės apibrėžimas“.
Tai pasakius, esu įsitikinęs, kad tai yra šiek tiek kodo, į kurį grįšite ir daug naudosite!
Autoriaus įvadas:
Mitchell Pond yra duomenų atkūrimo ekspertas DataNumen, Inc., kuri yra pasaulyje duomenų atkūrimo technologijų lyderė, įskaitant remontas SQL Server duomenys ir Excel atkūrimo programinės įrangos produktai. Norėdami gauti daugiau informacijos, apsilankykite WWW.datanumen.com