Экспортировать информацию из Microsoft Access невероятно просто — при условии, что вы хотите создать только один экспортный файл. Но что делать, если нужно разделить запрос (или таблицу) на несколько файлов экспорта? Например, если вам нужно экспортировать список транзакций клиентов каждый месяц — у каждого клиента есть свой файл экспорта? Вот где эта статья может помочь вам. Создать экспорт из 2, 10 или сотни различных экспортов будет так же просто, как запустить небольшой фрагмент кода VBA, и работа будет завершена за считанные секунды, а не часы ручного вырезания/вставки. Итак, начнем…
Подход
Поскольку мы хотим, чтобы это было как можно более гибким и удобным в использовании, код для этой статьи будет немного длиннее, чем обычно, но вскоре вы поймете, почему.
Во-первых, давайте наметим, чего мы хотим достичь:
Учитывая запрос, выводить новый файл каждый раз, когда значение в указанном поле изменяется.
Задача
Для этого нам нужно иметь возможность просматривать результаты запроса, сравнивая соответствующее поле в текущей строке со значением в предыдущей строке — и, если они отличаются, создать новый файл иtart вывод результатов запроса туда.
Для чего это НЕ подходит
Как я уже упоминал, существует множество причин, по которым вы хотели бы экспортировать части своей базы данных, но использование ее в качестве формы резервного копирования/архивирования не является одной из них — уж точно не с тем подходом, к которому я отношусь. использовать здесь - последнее, что вы хотите сделать, если вы столкнулись с восстановлением после поврежденная база данных mdb работает над тем, как сшить множество экспортов вместе!
Решение?
Всегда есть много способов содрать шкуру с кошки, этот способ всего один, но, я думаю, он работает довольно хорошо. Сначала мы прочитаем запрос в массив, чтобы упростить перемещение. Далее мы пройдемся по этому массиву, проверяя, нашли ли мы новое значение в соответствующем поле или нет. Если это не новое значение, мы выводим всю запись в текущий файл, который мы записываем, если это новое значение, мы закрываем этот файл и starта новый.
И код…
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
Что делает код — ключевые моменты
Я добавил комментарии к коду в most ключевые места, но есть еще пара вещей, на которые стоит обратить внимание.
Во-первых, мы разделили код на две подпрограммы. Первый проверяет, должна ли текущая запись быть записана в тот же файл, над которым мы сейчас работаем, или она должна быть записана в новый файл. Вторая подпрограмма выводит сведения обо всей записи в файл. Это было сделано таким образом, чтобы сократить дублирование в коде, иначе вы бы увидели одно и то же зацикливание во многих местах.
Во-вторых, я использую «Определение запроса», чтобы получить подробную информацию о запросе, над которым мы работаем. Определение таблицы».
С учетом сказанного, я вполне уверен, что это фрагмент кода, на который вы будете ссылаться и использовать много раз!
Об авторе:
Митчелл Понд — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая ремонт SQL Server данным и программные продукты для восстановления Excel. Для получения дополнительной информации посетите www.datanumen.com