L'esportazione di informazioni da Microsoft Access è incredibilmente semplice, supponendo che tu voglia produrre un solo file di esportazione. Ma cosa fai quando devi dividere una query (o una tabella) in più file di esportazione? Ad esempio, se devi esportare un elenco di transazioni dei clienti ogni mese - ogni cliente ha il proprio file di esportazione? Ecco dove questo articolo può aiutarti. Produrre un'esportazione di 2, 10 o un centinaio di esportazioni diverse sarà semplice come eseguire un piccolo frammento di codice VBA e il lavoro sarà completato in pochi secondi, non in ore di taglia/incolla manuale. Quindi cominciamo...
L'approccio
Poiché vogliamo che questo sia il più flessibile e utilizzabile possibile, il codice per questo articolo sarà un po' più lungo del solito, ma presto capirete perché.
In primo luogo, delineamo ciò che vogliamo essere in grado di ottenere:
Data una query, emette un nuovo file ogni volta che cambia un valore in un campo specificato.
La sfida
Per fare ciò, dobbiamo essere in grado di scorrere i risultati della query, confrontando il campo pertinente nella riga corrente con il valore nella riga precedente e, se sono diversi, creare un nuovo file e start emettere lì i risultati della query.
A cosa NON è adatto
Come ho già detto, ci sono molti motivi per cui vorresti esportare parti del tuo database, ma usarlo come forma di backup/archiviazione non è uno di questi, certamente non con l'approccio che sto using here – l'ultima cosa che vuoi fare se ti trovi di fronte al recupero da un file database mdb corrotto sta studiando come ricucire molte esportazioni!
La soluzione?
Ci sono sempre molti modi per scuoiare un gatto, questo è solo uno, ma credo che funzioni piuttosto bene. Per prima cosa leggeremo la query in un array per facilitare lo spostamento. Successivamente eseguiremo un ciclo su quell'array, controllando se abbiamo trovato o meno un nuovo valore nel campo pertinente. Se non è un nuovo valore, emettiamo l'intero record nel file corrente che stiamo scrivendo, se è nuovo, chiuderemo quel file e staruno nuovo.
E il codice...
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
Cosa sta facendo il codice - punti chiave
Ho aggiunto commenti al codice in most luoghi chiave, ma ci sono ancora un paio di cose che vale la pena sottolineare.
Primo: abbiamo diviso il codice in due routine. Il primo controlla se il record corrente deve essere scritto nello stesso file su cui stiamo attualmente lavorando o se deve essere scritto in un nuovo file. La seconda routine emette i dettagli per l'intero record nel file. È stato fatto in questo modo per ridurre la duplicazione nel codice, altrimenti vedresti lo stesso loop che si verifica in molti punti.
Secondo - sto usando la "Definizione della query" per ottenere dettagli sulla query su cui stiamo lavorando - se vuoi essere in grado di adattare questo per lavorare con le tabelle, dovresti cercare di scambiarlo in modo che usi il " Definizione tabella" invece.
Detto questo, sono abbastanza fiducioso che questo sia un po 'di codice a cui farai riferimento e che utilizzerai molto!
Introduzione dell'autore:
Mitchell Pond è un esperto di recupero dati in DataNumen, Inc., che è il leader mondiale nelle tecnologie di recupero dati, tra cui riparazione SQL Server dati ed eccellere prodotti software di recupero. Per maggiori informazioni visita www.datanumen.com