Teabe eksportimine Microsoft Accessist on uskumatult lihtne – eeldades, et soovite luua ainult ühe ekspordifaili. Aga mida teha, kui teil on vaja päring (või tabel) jagada mitmeks ekspordifailiks? Näiteks kui teil on vaja iga kuu eksportida klienditehingute loend – igal kliendil on oma ekspordifail? Siin võib see artikkel teid aidata. 2, 10 või saja erineva eksporditava ekspordi loomine on sama lihtne kui väikese VBA koodijupi käivitamine ja töö lõpetatakse sekunditega, mitte tundidepikkuse käsitsi lõikamise/kleepimisega. Nii et alustame…
Lähenemine
Kuna soovime, et see oleks võimalikult paindlik ja kasutatav, on selle artikli kood tavapärasest pisut pikem, kuid peagi näete, miks.
Esiteks – kirjeldame, mida me tahame saavutada:
Kui päring on antud, väljastage uus fail iga kord, kui määratud välja väärtus muutub.
Väljakutse
Selleks peame saama päringu tulemusi samm-sammult läbi vaadata, võrreldes praeguse rea vastavat välja eelmise rea väärtusega – ja kui need erinevad, looma uue faili ning hakkama päringu tulemusi sinna väljastama.
Milleks see EI sobi
Nagu ma juba mainisin – on palju põhjuseid, miks soovite oma andmebaasi osi eksportida, kuid selle kasutamine varundamise/arhiivimise eesmärgil ei kuulu nende hulka – kindlasti mitte selle lähenemisviisi puhul, mida ma kasutan. kasutades siin – viimane asi, mida teha tahate, kui seisate silmitsi taastumisega a rikutud mdb andmebaas töötab välja, kuidas palju eksporti kokku ühendada!
Lahendus?
Kassi nülgimiseks on alati palju võimalusi, see on vaid üks – aga minu arvates toimib see päris hästi. Esmalt loeme päringu massiivi, et ringiliikumist lihtsustada. Seejärel käime selle massiivi läbi, kontrollides, kas oleme vastavas väljas leidnud uue väärtuse või mitte. Kui see pole uus väärtus, väljastame kogu kirje parajasti kirjutatavasse faili; kui see on uus, sulgeme faili ja alustame uut.
Ja kood…
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
Mida kood teeb – põhipunktid
Olen koodile enamikesse olulistesse kohtadesse kommentaare lisanud, aga on siiski paar asja, mis väärivad esiletõstmist.
Esiteks oleme koodi jaganud kaheks rutiiniks. Esimene kontrollib, kas praegune kirje tuleks kirjutada samasse faili, mille kallal praegu töötame, või tuleks see kirjutada uude faili. Teine rutiin väljastab faili kogu kirje üksikasjad. Seda on tehtud nii, et vähendada koodi dubleerimist, vastasel juhul näete paljudes kohtades sama silmust.
Teiseks – ma kasutan päringu definitsiooni, et saada üksikasju päringu kohta, mille vastu töötame – kui soovite kohandada seda tabelitega töötamiseks, võiksite selle vahetada nii, et see kasutaks Tabeli definitsioon” asemel.
Seda silmas pidades olen üsna kindel, et see on koodiosa, millele viidate tagasi ja mida kasutate palju!
Autori sissejuhatus:
Mitchell Pond on andmete taastamise ekspert DataNumen, Inc., mis on maailmas juhtiv andmete taastamise tehnoloogiate, sealhulgas remont SQL Server andmed ja Exceli taastamise tarkvaratooted. Lisateabe saamiseks külastage www.datanumenCom