Ako exportovať výsledky dotazu do viacerých súborov pomocou Access VBA

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í prechádzať výsledkami dotazu a porovnávať príslušné pole v aktuálnom riadku s hodnotou v predchádzajúcom riadku - a ak sú odlišné, vytvorte nový súbor a start výstup výsledkov dotazu tam.

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 mačku stiahnuť z kože, tento spôsob je len jeden - myslím si však, že funguje celkom dobre. Najskôr načítame dopyt do poľa, aby sme uľahčili pohyb. Ďalej budeme prechádzať cez toto pole a skontrolovať, či sme v príslušnom poli našli novú hodnotu alebo nie. Pokiaľ nejde o novú hodnotu, odošleme celý záznam do aktuálneho súboru, ktorý píšeme, ak je nový, zatvoríme tento súbor a starta 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 Ako variant Dim Dim fldnames (), headerString As String 'získať podrobnosti o dotaze, ktorý budeme exportovať Set objRecordset = New ADODB.Recordset Set db = CurrentDb Set qdf = db.QueryDefs (queryName)' načítať dopyt do sady záznamov, aby sme s ňou mohli pracovať objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly 'načíta sadu záznamov do poľa data = objRecordset.GetRows' zatvorí sadu záznamov tak, ako sme teraz skončili. Zatvorte 'získajte podrobnosti o veľkosti poľa a polohe poľa, ktoré v tomto poli kontrolujeme colno = qdf.Fields (fieldName) .OrdinalPosition numrows = UBound (data, 2) numcols = UBound (d ata, 1) „pretože budeme musieť vypísať hlavičku pre každý súbor - získajte názvy polí pre túto hlavičku“ a zostrojiť reťazec hlavičky ReDim fldnames (numcols) For fldcounter = 0 To qdf.Fields.Count - 1 fldnames (fldcounter) = qdf.Fields (fldcounter). Názov Ďalej headerString = Pripojiť (fldnames, delim) 'pripraviť rozhranie skriptovania súborov, aby sme mohli vytvárať a zapisovať do našich súborov Set fs = CreateObject ("Scripting.FileSystemObject") 'Prejde cez naše pole a výstup do súboru For loopcount = 0 Na 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 writeetoFile data, queryName, fwriter, loopcount, numcols Iné dáta writeetoFile, delim, fwriter, loopcount, numcolsEnd If Else Set fwriter = fs.createTextfile (filePath & data (colno, loopcount) & ".txt", True) fwriter.writeline headerString writeetoFile data, delim, fwriter, loopcount, numcols End If Next 'urobte poriadok po sebe fwriter. Zatvoriť Nastaviť fwriter = Nič Nastaviť objRecordset = Nič Nastaviť db = Nič Nastaviť qdf = Nič Koniec Sub 'parametre sú odovzdané "odkazom", aby sa zabránilo presunutiu potenciálne veľkých objektov v pamäti Sub writeetoFile (dáta ByRef ako variant, ByVal delim ako variant, ByRef fwriter Ako Variant, Počítadlo ByVal Rovnako dlho, ByVal numcols Ako Celé číslo) Stlmiť počet slučiek Ako Celé číslo Dim outstr Ako String Pre loopcount = 0 To numcols outstr = outstr & data (loopcount, counter) If loopcount <numcols Then outstr = outstr & delim Ďalej .pisová línia out End Sub

Čo robí kód - kľúčové body

Pridal som komentáre ku kódu v most kľúčové miesta, ale stále je tu pár vecí, ktoré stoja za vyzdvihnutie.

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