Izvoz informacij iz Microsoftovega dostopa je neverjetno enostaven - ob predpostavki, da želite ustvariti samo eno izvozno datoteko. Kaj pa storite, ko morate poizvedbo (ali tabelo) razdeliti na več izvoznih datotek? Če morate na primer vsak mesec izvoziti seznam transakcij strank - vsaka stranka ima svojo izvozno datoteko? Tu vam lahko pomaga ta članek. Izvoz 2, 10 ali sto različnih izvozov bo tako preprost kot zagon majhnega delčka kode VBA in opravilo bo končano v nekaj sekundah, ne v urah ročnega rezanja / lepljenja. Začnimo torej ...
Pristop
Ker želimo, da je to čim bolj prilagodljivo in uporabno, bo koda za ta članek nekoliko daljša kot običajno, vendar boste kmalu videli, zakaj.
Najprej - opišimo, kaj želimo doseči:
Glede na poizvedbo izpišite novo datoteko vsakič, ko se spremeni vrednost v določenem polju.
Izziv
Da bi to naredili, moramo biti sposobni korak za korakom pregledati rezultate poizvedbe in primerjati ustrezno polje v trenutni vrstici z vrednostjo v prejšnji vrstici – in če se razlikujejo, ustvariti novo datoteko in tam začeti izpisovati rezultate poizvedbe.
Za kaj to NI primerno
Kot sem že omenil - obstaja veliko razlogov, zakaj bi želeli izvoziti svoje baze podatkov, vendar uporaba kot oblika varnostnega kopiranja / arhiviranja ni eden izmed njih - zagotovo ne s pristopom, ki sem ga z uporabo tukaj - zadnja stvar, ki jo želite storiti, če se soočate z okrevanjem po a poškodovana baza podatkov mdb dela, kako speti veliko izvoza nazaj!
Rešitev?
Vedno obstaja veliko načinov za odrivanje mačke, ta način je le eden – ampak mislim, da deluje precej dobro. Najprej bomo poizvedbo prebrali v tabelo, da se bomo lažje premikali. Nato bomo zanko prešli skozi to tabelo in preverili, ali smo v ustreznem polju našli novo vrednost ali ne. Če ni nova vrednost, bomo celoten zapis izpisali v trenutno datoteko, v katero pišemo, če pa je nova, bomo to datoteko zaprli in začeli novo.
In koda ...
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
Kaj počne koda - ključne točke
Na večini ključnih mest sem kodi dodal komentarje, vendar je še vedno nekaj stvari, ki jih je vredno izpostaviti.
Najprej - kodo smo razdelili na dve rutini. Prvi preveri, ali naj bo trenutni zapis zapisan v isto datoteko, s katero trenutno delamo, ali pa naj bo zapisan v novo datoteko. Druga rutina prikaže podrobnosti celotnega zapisa v datoteko. To je bilo storjeno na ta način, da bi zmanjšali podvajanje v kodi, sicer bi videli, da se ista zanka dogaja marsikje.
Drugič - z “Definicijo poizvedbe” dobim podrobnosti o poizvedbi, proti kateri delamo - če želite to prilagoditi za delo s tabelami, si oglejte zamenjavo, tako da je uporabila “ Definicija tabele «.
S tem sem prepričan, da je to nekaj kode, na katero se boste sklicevali in jo veliko uporabljali!
Uvod avtorja:
Mitchell Pond je strokovnjak za obnovitev podatkov v DataNumen, Inc., ki je vodilna na svetu na področju tehnologij za obnovitev podatkov, vključno z popravilo SQL Server datum in excel programske izdelke za obnovitev. Za več informacij obiščite www.datanumen.com