Експортувати інформацію з Microsoft Access надзвичайно просто - припускаючи, що ви хочете створити лише один файл експорту. Але що ви робите, коли вам потрібно розділити запит (або таблицю) на кілька файлів експорту? Наприклад, якщо вам потрібно щомісяця експортувати список транзакцій клієнта - кожен клієнт має власний файл експорту? Ось тут ця стаття може вам допомогти. Виконати експорт 2, 10 або сотні різних експортів буде настільки ж просто, як запустити невеликий фрагмент коду VBA, і робота буде виконана за лічені секунди, а не за години ручного вирізання / вставки. Отже, почнемо ...
Підхід
Оскільки ми хочемо, щоб це було якомога гнучкіше та корисніше, код цієї статті буде трохи довшим, ніж зазвичай, але незабаром ви зрозумієте, чому.
По-перше - давайте окреслимо, чого ми хочемо досягти:
За запитом виводити новий файл кожного разу, коли значення у вказаному полі змінюється.
Змагання
Для цього нам потрібно мати можливість переходити до результатів запиту, порівнюючи відповідне поле в поточному рядку зі значенням у попередньому рядку - і якщо вони різні, створіть новий файл і start виведення туди результатів запиту.
Для чого це НЕ підходить
Як я вже зазначав, існує безліч причин, чому ви хочете експортувати частини бази даних, але використання її як форми резервного копіювання / архівування не є однією з них - звичайно, не з підходом, який я використання тут - останнє, що ви хочете зробити, якщо ви стикаєтесь з відновленням після пошкоджена база даних 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