Das Exportieren von Informationen aus Microsoft Access ist unglaublich einfach - vorausgesetzt, Sie möchten nur eine einzige Exportdatei erstellen. Was tun Sie jedoch, wenn Sie eine Abfrage (oder Tabelle) in mehrere Exportdateien aufteilen müssen? Wenn Sie beispielsweise jeden Monat eine Liste von Kundentransaktionen exportieren müssen - jeder Kunde hat seine eigene Exportdatei? Hier kann Ihnen dieser Artikel helfen. Das Erstellen eines Exports von 2, 10 oder hundert verschiedenen Exporten ist so einfach wie das Ausführen eines kleinen VBA-Code-Snippets, und der Auftrag ist in Sekunden erledigt, nicht in Stunden des manuellen Ausschneidens / Einfügens. Also fangen wir an ...
Die Vorgehensweise
Da dies so flexibel und benutzerfreundlich wie möglich sein soll, wird der Code für diesen Artikel etwas länger als gewöhnlich sein, aber Sie werden gleich sehen, warum.
Lassen Sie uns zunächst skizzieren, was wir erreichen wollen:
Geben Sie bei einer Abfrage jedes Mal eine neue Datei aus, wenn sich ein Wert in einem angegebenen Feld ändert.
Die Herausforderung
Dazu müssen wir in der Lage sein, die Ergebnisse der Abfrage zu durchlaufen und das relevante Feld in der aktuellen Zeile mit dem Wert in der vorherigen Zeile zu vergleichen. Wenn sie unterschiedlich sind, erstellen Sie eine neue Datei und start Ausgabe der Abfrageergebnisse dort.
Wofür das NICHT geeignet ist
Wie ich bereits erwähnt habe, gibt es viele Gründe, warum Sie Teile Ihrer Datenbank exportieren möchten, aber die Verwendung als Sicherungs- / Archivierungszweck gehört nicht dazu - schon gar nicht mit meinem Ansatz Verwenden Sie hier - das Letzte, was Sie tun möchten, wenn Sie sich von einem erholen müssen beschädigte MDB-Datenbank arbeitet daran, wie viele Exporte wieder zusammengefügt werden können!
Die Lösung?
Es gibt immer viele Möglichkeiten, eine Katze zu häuten, diese ist nur eine - aber eine, die meiner Meinung nach ziemlich gut funktioniert. Zuerst lesen wir die Abfrage in ein Array, um das Bewegen zu erleichtern. Als nächstes durchlaufen wir dieses Array und prüfen, ob wir im entsprechenden Feld einen neuen Wert gefunden haben oder nicht. Wenn es sich nicht um einen neuen Wert handelt, geben wir den gesamten Datensatz in die aktuelle Datei aus, die wir schreiben. Wenn er neu ist, schließen wir diese Datei und starta neu.
Und der Code ...
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
Was der Code tut - wichtige Punkte
Ich habe dem Code in m Kommentare hinzugefügtost Schlüsselstellen, aber es gibt noch ein paar Dinge, die es wert sind, hervorgehoben zu werden.
Erstens - wir haben den Code in zwei Routinen aufgeteilt. Der erste prüft, ob der aktuelle Datensatz in dieselbe Datei geschrieben werden soll, an der wir gerade arbeiten, oder ob er in eine neue Datei geschrieben werden soll. Die zweite Routine gibt die Details für den gesamten Datensatz in die Datei aus. Auf diese Weise wurde die Duplizierung im Code reduziert, da sonst an vielen Stellen dieselbe Schleife stattfindet.
Zweitens: Ich verwende die "Abfragedefinition", um Details zu der Abfrage zu erhalten, gegen die wir arbeiten. Wenn Sie diese an die Arbeit mit Tabellen anpassen möchten, sollten Sie diese austauschen, damit die "Abfragedefinition" verwendet wird. Tabellendefinition “stattdessen.
Trotzdem bin ich ziemlich zuversichtlich, dass dies ein bisschen Code ist, auf den Sie zurückgreifen und den Sie häufig verwenden werden!
Einführung des Autors:
Mitchell Pond ist ein Datenrettungsexperte in DataNumen, Inc., das weltweit führend bei Datenwiederherstellungstechnologien ist, einschließlich Reparatur- SQL Server frustrierten und Excel-Wiederherstellungssoftwareprodukte. Für weitere Informationen besuchen Sie www.datanumen.com €XNUMX