Експортирането на информация от Microsoft Access е невероятно лесно - ако приемем, че искате да създадете само един файл за експортиране. Но какво правите, когато трябва да разделите заявка (или таблица) на множество файлове за експортиране? Например, ако трябва да експортирате списък с клиентски транзакции всеки месец - всеки клиент има свой собствен файл за експортиране? Ето тук тази статия може да ви помогне. Извършването на експортиране на 2, 10 или сто различни износа ще бъде толкова просто, колкото стартирането на малко кодов фрагмент на VBA и работата ще бъде завършена за секунди, а не часове ръчно изрязване / поставяне. Така че нека да започнем ...
Подхода
Тъй като искаме това да бъде възможно най-гъвкаво и използваемо, кодът за тази статия ще бъде малко по-дълъг от обикновено, но скоро ще разберете защо.
Първо - нека очертаем какво искаме да можем да постигнем:
При дадена заявка извеждайте нов файл всеки път, когато се променя стойност в определено поле.
Предизвикателството
За да направим това, трябва да можем да прегледаме резултатите от заявката, сравнявайки съответното поле в текущия ред със стойността в предишния ред – и ако те са различни, да създадем нов файл и да започнем да извеждаме резултатите от заявката там.
За какво НЕ е подходящо това
Както вече споменах - има много причини, поради които бихте искали да експортирате части от вашата база данни, но използването й като форма за архивиране / архивиране не е една от тях - със сигурност не с подхода, който съм използване тук - последното нещо, което искате да направите, ако сте изправени пред възстановяване от корумпирана mdb база данни разработва как да съчетаем много износ обратно!
Решението?
Винаги има много начини да се одере котка, този начин е само един – но мисля, че работи доста добре. Първо ще прочетем заявката в масив, за да улесним придвижването. След това ще прегледаме този масив, проверявайки дали сме намерили нова стойност в съответното поле или не. Ако не е нова стойност, извеждаме целия запис в текущия файл, в който пишем, ако е нова, ще затворим този файл и ще започнем нов.
И кодът ...
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
Какво прави кодът - ключови моменти
Добавих коментари към кода на повечето ключови места, но все още има няколко неща, които си струва да се подчертаят.
Първо - разделихме кода на две процедури. Първият проверява дали текущият запис трябва да бъде записан в същия файл, по който работим в момента, или трябва да бъде записан в нов файл. Втората рутина извежда във файла подробностите за целия запис. Това е направено по този начин, за да се намали дублирането в кода, в противен случай ще видите същите цикли, които се провеждат на много места.
Второ - използвам „Определението на заявката“, за да получа подробности за заявката, срещу която работим - ако искате да можете да адаптирате това към работа с таблици, ще разгледате размяната, така че да използва „ Определение на таблица ”вместо това.
С това казах, аз съм доста уверен, че това е малко код, към който ще се обърнете и ще използвате много!
Въведение на автора:
Мичъл Понд е експерт по възстановяване на данни в DataNumen, Inc., която е световен лидер в технологиите за възстановяване на данни, включително ремонт SQL Server данни и excel софтуерни продукти за възстановяване. За повече информация посетете WWW.datanumen.com