Eksportowanie informacji z Microsoft Access jest niezwykle łatwe - zakładając, że chcesz utworzyć tylko jeden plik eksportu. Ale co robisz, gdy musisz podzielić zapytanie (lub tabelę) na wiele plików eksportu? Na przykład, jeśli musisz co miesiąc eksportować listę transakcji klientów - każdy klient ma swój własny plik eksportu? Tutaj może Ci pomóc ten artykuł. Wyeksportowanie 2, 10 lub stu różnych eksportów będzie tak proste, jak uruchomienie małego fragmentu kodu VBA, a zadanie zostanie zakończone w kilka sekund, a nie godzin ręcznego wycinania / wklejania. Więc zacznijmy…
Podejście
Ponieważ chcemy, aby było to jak najbardziej elastyczne i użyteczne, kod tego artykułu będzie trochę dłuższy niż zwykle, ale wkrótce przekonasz się, dlaczego.
Po pierwsze - nakreślmy, co chcemy osiągnąć:
Biorąc pod uwagę zapytanie, wyprowadź nowy plik za każdym razem, gdy zmieni się wartość w określonym polu.
Wyzwanie
Aby to zrobić, musimy mieć możliwość przejrzenia wyników zapytania, porównując odpowiednie pole w bieżącym wierszu z wartością w poprzednim wierszu. Jeśli są one różne, musimy utworzyć nowy plik i rozpocząć wyprowadzanie wyników zapytania właśnie tam.
Do czego to NIE jest odpowiednie
Jak już wspomniałem - istnieje wiele powodów, dla których chciałbyś wyeksportować części swojej bazy danych, ale używanie jej jako formy tworzenia kopii zapasowych / archiwizacji nie jest jednym z nich - na pewno nie przy podejściu używanie tutaj - ostatnia rzecz, którą chcesz zrobić, jeśli masz do czynienia z odzyskiwaniem z pliku uszkodzona baza danych mdb pracuje nad połączeniem wielu eksportów!
Rozwiązanie?
Zawsze jest wiele sposobów na oskórowanie kota, ten sposób jest tylko jednym – ale myślę, że całkiem dobrym. Najpierw odczytamy zapytanie do tablicy, aby ułatwić poruszanie się po niej. Następnie przejdziemy przez tę tablicę, sprawdzając, czy znaleźliśmy nową wartość w odpowiednim polu. Jeśli to nie jest nowa wartość, zapisujemy cały rekord do aktualnie zapisywanego pliku. Jeśli jest nowy, zamkniemy ten plik i utworzymy nowy.
A kod…
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
Co robi kod - kluczowe punkty
Dodałem komentarze do kodu w większości kluczowych miejsc, ale jest jeszcze parę rzeczy, na które warto zwrócić uwagę.
Po pierwsze - podzieliliśmy kod na dwie procedury. Pierwsza sprawdza, czy bieżący rekord powinien zostać zapisany w tym samym pliku, nad którym obecnie pracujemy, czy też powinien zostać zapisany w nowym pliku. Druga procedura wyprowadza szczegóły całego rekordu do pliku. Zostało to zrobione w ten sposób, aby ograniczyć powielanie w kodzie, w przeciwnym razie zobaczyłbyś takie same pętle występujące w wielu miejscach.
Po drugie - używam „Definicja zapytania”, aby uzyskać szczegółowe informacje o zapytaniu, nad którym pracujemy - jeśli chcesz mieć możliwość dostosowania tego do pracy z tabelami, przyjrzyj się zamianie go, aby używał opcji „ Definicja tabeli ”.
Powiedziawszy to, jestem pewien, że jest to fragment kodu, do którego będziesz się odwoływać i będziesz go często używać!
Wprowadzenie autora:
Mitchell Pond jest ekspertem w dziedzinie odzyskiwania danych w DataNumen, Inc., która jest światowym liderem w technologiach odzyskiwania danych, w tym naprawa SQL Server dane i doskonałe oprogramowanie do odzyskiwania. po więcej informacji odwiedź www.datanumen.com