Как экспортировать результаты запроса в несколько файлов с помощью Access VBA

Экспортировать информацию из Microsoft Access невероятно просто — при условии, что вы хотите создать только один экспортный файл. Но что делать, если нужно разделить запрос (или таблицу) на несколько файлов экспорта? Например, если вам нужно экспортировать список транзакций клиентов каждый месяц — у каждого клиента есть свой файл экспорта? Вот где эта статья может помочь вам. Создать экспорт из 2, 10 или сотни различных экспортов будет так же просто, как запустить небольшой фрагмент кода VBA, и работа будет завершена за считанные секунды, а не часы ручного вырезания/вставки. Итак, начнем…

Подход

Поскольку мы хотим, чтобы это было как можно более гибким и удобным в использовании, код для этой статьи будет немного длиннее, чем обычно, но вскоре вы поймете, почему.

Во-первых, давайте наметим, чего мы хотим достичь:

Учитывая запрос, выводить новый файл каждый раз, когда значение в указанном поле изменяется.

Задача

Для этого нам нужно иметь возможность просматривать результаты запроса, сравнивая соответствующее поле в текущей строке со значением в предыдущей строке — и, если они отличаются, создать новый файл иtart вывод результатов запроса туда.

Для чего это НЕ подходит

Как я уже упоминал, существует множество причин, по которым вы хотели бы экспортировать части своей базы данных, но использование ее в качестве формы резервного копирования/архивирования не является одной из них — уж точно не с тем подходом, к которому я отношусь. использовать здесь - последнее, что вы хотите сделать, если вы столкнулись с восстановлением после поврежденная база данных mdb работает над тем, как сшить множество экспортов вместе!

Решение?

Всегда есть много способов содрать шкуру с кошки, этот способ всего один, но, я думаю, он работает довольно хорошо. Сначала мы прочитаем запрос в массив, чтобы упростить перемещение. Далее мы пройдемся по этому массиву, проверяя, нашли ли мы новое значение в соответствующем поле или нет. Если это не новое значение, мы выводим всю запись в текущий файл, который мы записываем, если это новое значение, мы закрываем этот файл и starта новый.

И код…

Sub DoExport (fieldName As String, queryName As String, filePath As String, дополнительный разделитель 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 'получить детали запроса, который мы будем экспортировать Set objRecordset = New ADODB.Recordset Set db = CurrentDb Set qdf = db.QueryDefs(queryName) 'загрузить сделать запрос в набор записей, чтобы мы могли с ним работать objRecordset.Open qdf.SQL, CurrentProject.Connection, adOpenDynamic, adLockReadOnly 'загрузить набор записей в массив data = objRecordset.GetRows 'закрыть набор записей, когда мы с ним закончили objRecordset. Close 'получить сведения о размере массива и позиции поля, которое мы проверяем в этом массиве colno = qdf.Fields(fieldName).OrdinalPosition numrows = UBound(data, 2) numcols = UBound(data, 1) ' так как нам нужно будет написать заголовок для каждого файла — получить имена полей для этого заголовка и создать строку заголовка .Fields(fldcounter).Name Next headerString = Join(fldnames, delim) 'подготовить интерфейс файлового сценария, чтобы мы могли создавать и записывать в наш файл(ы) Set fs = CreateObject("Scripting.FileSystemObject") 'перебирать наш массив и вывод в файл For loopcount = 0 To numrows Если loopcount > 1 Then If data(colno, loopcount) <> data(colno, loopcount - 0) Then If Not IsEmpty(fwriter) Then fwriter.Close Установить 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 Установить fwriter = fs. createTextfile(filePath & data(colno, loopcount) & ".txt", True) fwriter.writeline headerString writetoFile data, delim, fwriter, loopcount, numcols End If Next 'убрать за собой fwriter.Close Set fwriter = Nothing Set objRecordset = Nothing Set db = Nothing Set qdf = Nothing End Подпараметры передаются «по ссылке», чтобы предотвратить перемещение потенциально больших объектов в памяти 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) Если loopcount < numcols Then outstr = outstr & delim Next fwriter.writeline outstr End Sub

Что делает код — ключевые моменты

Я добавил комментарии к коду в most ключевые места, но есть еще пара вещей, на которые стоит обратить внимание.

Во-первых, мы разделили код на две подпрограммы. Первый проверяет, должна ли текущая запись быть записана в тот же файл, над которым мы сейчас работаем, или она должна быть записана в новый файл. Вторая подпрограмма выводит сведения обо всей записи в файл. Это было сделано таким образом, чтобы сократить дублирование в коде, иначе вы бы увидели одно и то же зацикливание во многих местах.

Во-вторых, я использую «Определение запроса», чтобы получить подробную информацию о запросе, над которым мы работаем. Определение таблицы».

С учетом сказанного, я вполне уверен, что это фрагмент кода, на который вы будете ссылаться и использовать много раз!

Об авторе:

Митчелл Понд — эксперт по восстановлению данных в DataNumen, Inc., которая является мировым лидером в области технологий восстановления данных, включая ремонт SQL Server данным и программные продукты для восстановления Excel. Для получения дополнительной информации посетите www.datanumen.com