Az információk exportálása a Microsoft Accessből hihetetlenül egyszerű – feltéve, hogy csak egyetlen exportfájlt szeretne létrehozni. De mi a teendő, ha egy lekérdezést (vagy táblázatot) több exportfájlra kell felosztania? Például, ha minden hónapban exportálnia kell az ügyféltranzakciók listáját – minden ügyfélnek saját exportfájlja van? Ebben segíthet ez a cikk. A 2, 10 vagy száz különböző exportálás exportálása olyan egyszerű lesz, mint egy kis VBA kódrészlet futtatása, és a munka másodpercek alatt befejeződik, nem órákon át tartó kézi kivágás/beillesztés. Tehát kezdjük…
A megközelítés
Mivel azt szeretnénk, hogy ez a lehető legrugalmasabb és használhatóbb legyen, ennek a cikknek a kódja egy kicsit hosszabb lesz a szokásosnál, de hamarosan kiderül, miért.
Először is – vázoljuk fel, mit szeretnénk elérni:
Adott lekérdezés esetén adjon ki új fájlt minden alkalommal, amikor egy adott mezőben egy érték megváltozik.
A kihívás
Ehhez képesnek kell lennünk végigmenni a lekérdezés eredményein, összehasonlítva az aktuális sor releváns mezőjét az előző sor értékével – és ha eltérnek, létre kell hoznunk egy új fájlt, és ott kell elkezdenünk a lekérdezés eredményeinek kimenetét.
Mire ez NEM alkalmas
Ahogy már említettem – rengeteg oka van annak, hogy miért szeretné exportálni az adatbázis egy részét, de biztonsági mentési/archiválási célból való felhasználása nem tartozik ezek közé – természetesen nem az általam használt megközelítéssel. itt használva – az utolsó dolog, amit tenni szeretne, ha az a sérült mdb adatbázis azon dolgozik, hogyan fűzhet össze sok exportot!
A megoldás?
Mindig rengeteg módja van a macskanyúzásnak, ez csak egy – de szerintem elég jól működő – módszer. Először is beolvassuk a lekérdezést egy tömbbe, hogy megkönnyítsük a mozgást. Ezután végigmegyünk a tömbön, és ellenőrizzük, hogy találtunk-e új értéket a releváns mezőben vagy sem. Ha nem új értékről van szó, akkor a teljes rekordot kiírjuk az aktuális fájlba, amit írunk, ha új, akkor bezárjuk a fájlt, és egy újat kezdünk.
És a kód…
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 csinál a kód – kulcsfontosságú pontok
A legtöbb kulcsfontosságú helyen megjegyzéseket fűztem a kódhoz, de még mindig van néhány dolog, amit érdemes kiemelni.
Először is – a kódot két rutinra osztottuk. Az első ellenőrzi, hogy az aktuális rekordot ugyanabba a fájlba kell-e írni, amelyen jelenleg dolgozunk, vagy új fájlba. A második rutin a teljes rekord részleteit adja ki a fájlba. Ezt azért csinálták, hogy csökkentsék a duplikációt a kódban, különben sok helyen ugyanazt a hurkolást látná.
Másodszor – a „Lekérdezés definícióját” használom, hogy részleteket kapjak arról a lekérdezésről, amely ellen dolgozunk – ha szeretné adaptálni ezt a táblákkal való együttműködésre, akkor érdemes megcserélni, hogy a „ Táblázat definíció” helyett.
Ennek ellenére biztos vagyok benne, hogy ez egy olyan kód, amelyre vissza fog térni, és sokat fog használni!
Szerző Bevezetés:
Mitchell Pond adat-helyreállítási szakértő DataNumen, Inc., amely világelső az adat-helyreállítási technológiák területén, beleértve javítás SQL Server Az információk szétdarabolódása és Excel helyreállítási szoftvertermékek. További információért látogasson el www.datanumen.com