Tietojen vieminen Microsoft Accessista on uskomattoman helppoa - olettaen, että haluat tuottaa vain yhden vientitiedoston. Mutta mitä teet, kun sinun on jaettava kysely (tai taulukko) useiksi vientitiedostoiksi? Esimerkiksi, jos sinun on vietävä luettelo asiakastapahtumista kuukausittain - jokaisella asiakkaalla on oma vientitiedosto? Siellä tämä artikkeli voi auttaa sinua. 2, 10 tai sadan eri viennin tuottaminen on yhtä yksinkertaista kuin pienen VBA-koodinpätkän suorittaminen, ja työ valmistuu sekunneissa, ei tuntien manuaalisen leikkaamisen / liittämisen aikana. Joten aloitetaan ...
Lähestyminen
Koska haluamme, että tämä on mahdollisimman joustavaa ja käyttökelpoista, tämän artikkelin koodi tulee olemaan hieman tavallista pidempi, mutta näet pian, miksi.
Ensinnäkin - hahmotellaan, mitä haluamme saavuttaa:
Anna kysely, lähetä uusi tiedosto aina, kun määritetyn kentän arvo muuttuu.
Haaste
Tätä varten meidän on voitava käydä kyselyn tulokset läpi askel kerrallaan vertaamalla nykyisen rivin asiaankuuluvaa kenttää edellisen rivin arvoon – ja jos ne eroavat toisistaan, luotava uusi tiedosto ja aloitettava kyselyn tulosten tulostaminen sinne.
Mihin tämä EI sovellu
Kuten olen jo maininnut - on paljon syitä, miksi haluat viedä tietokannan osia, mutta sen käyttö varmuuskopioinnin / arkistoinnin muodossa ei ole yksi niistä - ei todellakaan minun lähestymistapani kanssa käyttää tätä - viimeinen asia, jonka haluat tehdä, jos kohtaat toipumisen vioittunut mdb-tietokanta pyrkii yhdistämään paljon vientiä yhteen!
Ratkaisu?
Kissan nylkemiseen on aina monia tapoja, tämä on vain yksi – mutta mielestäni aika hyvin toimiva. Ensin luemme kyselyn taulukkoon, jotta liikkuminen olisi helpompaa. Seuraavaksi käymme taulukon läpi ja tarkistamme, olemmeko löytäneet uuden arvon kyseisestä kentästä vai emme. Jos se ei ole uusi arvo, tulostamme koko tietueen nykyiseen tiedostoon, jota kirjoitamme. Jos se on uusi, suljemme tiedoston ja aloitamme uuden.
Ja koodi ...
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
Mitä koodi tekee - tärkeimmät kohdat
Olen lisännyt kommentteja koodiin useimpiin tärkeisiin paikkoihin, mutta pari asiaa on silti syytä korostaa.
Ensinnäkin - olemme jakaneet koodin kahteen rutiiniin. Ensimmäinen tarkistaa, pitäisikö nykyinen tietue kirjoittaa samaan tiedostoon, jota parhaillaan työskentelemme, vai onko se kirjoitettava uuteen tiedostoon. Toinen rutiini tuottaa koko tietueen yksityiskohdat tiedostoon. Se on tehty tällä tavalla vähentämään päällekkäisyyksiä koodissa, muuten näet saman silmukan tapahtuvan monissa paikoissa.
Toiseksi - Käytän kyselyn määritelmää saadaksesi lisätietoja kyselystä, jota vastaan työskentelemme - jos haluat pystyä mukauttamaan tämän toimimaan taulukoiden kanssa, sinun kannattaa vaihtaa se niin, että se käytti " Taulukon määritelmä ”.
Tämän sanottuani olen melko varma, että tämä on vähän koodia, johon viittaat takaisin ja käytät paljon!
Tekijän esittely:
Mitchell Pond on tietojen palauttamisen asiantuntija DataNumen, Inc., joka on maailman johtava tietojen palautustekniikoissa, mukaan lukien korjaus SQL Server tiedot ja Excel-palautusohjelmistotuotteet. Lisätietoja osoitteessa www.datanumen.com