Export informácií z aplikácie Microsoft Access je neuveriteľne ľahký - za predpokladu, že chcete vytvoriť iba jeden exportovaný súbor. Čo však robiť, keď potrebujete rozdeliť dopyt (alebo tabuľku) na viac exportovaných súborov? Napríklad, ak potrebujete každý mesiac exportovať zoznam transakcií so zákazníkmi - každý zákazník má svoj vlastný súbor na export? Tam vám môže pomôcť tento článok. Produkcia exportu 2, 10 alebo sto rôznych exportov bude taká jednoduchá ako spustenie malého útržku kódu VBA a úloha bude hotová za pár sekúnd, nie za hodiny ručného rezania / vkladania. Takže začnime ...
Prístup
Pretože chceme, aby to bolo čo najpružnejšie a použiteľnejšie, bude kód pre tento článok o niečo dlhší ako obvykle, ale čoskoro uvidíte, prečo.
Po prvé - načrtnime si, čo chceme byť schopní dosiahnuť:
Pri zadaní dotazu vygenerujte nový súbor zakaždým, keď sa zmení hodnota v zadanom poli.
Výzva
Aby sme to mohli urobiť, musíme byť schopní prejsť si výsledky dotazu krok za krokom, porovnať príslušné pole v aktuálnom riadku s hodnotou v predchádzajúcom riadku – a ak sa líšia, vytvoriť nový súbor a začať tam zobrazovať výsledky dotazu.
Na čo to NIE JE vhodné
Ako som už spomenul - existuje veľa dôvodov, prečo by ste chceli exportovať časti svojej databázy, ale použitie ako forma zálohovania / archivácie nie je jedným z nich - určite nie s prístupom, ktorý používam. použitie tu - posledná vec, ktorú chcete urobiť, ak čelíte zotaveniu z a poškodená mdb databáza pracuje na tom, ako spojiť veľa vývozov späť dohromady!
Riešenie?
Vždy existuje veľa spôsobov, ako stiahnuť mačku z kože, tento spôsob je len jeden – ale myslím si, že funguje celkom dobre. Najprv načítame dotaz do poľa, aby sme sa v ňom ľahšie pohybovali. Potom budeme prechádzať týmto polem a kontrolovať, či sme v príslušnom poli našli novú hodnotu alebo nie. Ak to nie je nová hodnota, celý záznam vypíšeme do aktuálneho súboru, do ktorého zapisujeme, ak je nový, zatvoríme tento súbor a začneme nový.
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
Čo robí kód - kľúčové body
Do kódu som pridal komentáre na väčšine kľúčových miest, ale stále je tu niekoľko vecí, ktoré stojí za to zdôrazniť.
Po prvé - rozdelili sme kód do dvoch rutín. Prvý kontroluje, či sa má aktuálny záznam zapísať do rovnakého súboru, na ktorom momentálne pracujeme, alebo či sa má zapísať do nového súboru. Druhá rutina odosiela do súboru podrobnosti celého záznamu. Bolo to urobené týmto spôsobom, aby sa obmedzila duplicita v kóde, inak by ste videli rovnaké opakovanie na mnohých miestach.
Druhá - používam „Definíciu dotazu“ na získanie podrobností o dotaze, proti ktorému pracujeme - ak chcete byť schopní prispôsobiť to práci s tabuľkami, pozreli by ste sa na ich zámenu tak, aby používala „ Namiesto toho definícia tabuľky.
Vďaka tomu som si dosť istý, že ide o trochu kódu, na ktorý sa vrátite a budete ho veľa používať!
Úvod autora:
Mitchell Pond je expert na obnovu dát v DataNumen, Inc., ktorá je svetovým lídrom v oblasti technológií obnovy dát, vrátane oprava SQL Server data a vynikajúce softvérové produkty na obnovenie. Pre viac informácií navštívte www.datanumen. S