Перенос данных из Access в Excel, стал одной из стандартных задач, решаемых программистами VBA. Стараясь делать передачу данных быстрой, надежной и универсальной я натолкнулся на некоторые интересные методы и особенности, которыми считаю нужным поделиться, рассчитывая получить в ответ новые идеи а также в надежде на то, что некоторое количество людей сможет избежать моих ошибок.
Тестируемые методы:
Ниже приведен список методов с текстом кода и комментариями, преимуществами и недостатками: Обратите внимание на следующее: во-первых, это - не все возможные методы, я с удовольствием приму и протестирую любой метод, не указанный здесь, во-вторых - не все методы до конца оптимизированы (я также буду рад любым предложениям по изменениям, направленным на улучшение работы приведенных способов), и наконец, возможно имеются другие доступные методы и способы в более поздних версиях MS Office - я ограничился только MS Office 97.
Задача состояла в том, чтобы измерить скорость различных методов помещения результата выполнения строки sql на рабочем листе Excel. Сразу оговоримся, что не все процедуры равны в этом отношении, так как некоторые из них (например, OutputTo), создают xls файл на диске, в то время как другим (RunCommand например) файл необходимо сохранить после создания. С другой стороны, первый тип методов не может создать рабочую книгу с множеством листов или помещать данные в указанном месте рабочего листа - вы должны "собрать" листы в одной рабочей книге после помещения их на диск и обработать результаты. Также различные методы различаются по их чувствительности к ошибкам, возможно присутствующим в наборе записей. Таким образом задача испытаний формулируется следующим образом: "Поместить результат выполнения cтроки sql на отдельный лист Excel. Как только данные находятся на рабочем листе, задача считается выполненной"
Способ тестирования:
Для испытаний использовались Microsoft Access / Excel 97 SR-2. Под WinNT 4.0 на машине Pentium Intel IV 2200, 256МБ, 30GB. Данные передаются из локальной таблицы, содержащейся 13 полей и 10000 записей на вновь создаваемый рабочий лист Excel.
Тестовая процедура:
Sub Test()
Dim XL As Object Dim WB As Workbook Dim WS As Worksheet Dim rs As Recordset Dim i As Integer Dim j As Integer Dim f1 As String Dim sql As String Dim n As Long, m As Long Dim x As Long Dim y As Long Dim Dummy As Variant Dim a As Double Dim arr As Variant
arr = Array(10, 50, 100, 300, 500, 1000, 2000, 3000, 5000, 10000) 'array to limit record number
Set XL = CreateObject("excel.application")
XL.SheetsInNewWorkbook = 1
Set WB = XL.Workbooks.Add Set WS = WB.Worksheets(1) For i = 1 To 10
sql = "SELECT TOP " & arr(i - 1) & " IIf([ID]='ID',1/0,0),* FROM Table" 'iif используется для генерации ошибки деления на ноль
x = 1 y = 1
For j = 1 To 10 a = timer
Call SKXLOut(WS, sql) ' здесь тестовая процедура вызывается 10 раз CurrentDb.Execute ("INSERT INTO Table3 (Procid, [Time], Rows) Values( 9," & _ ((timer - a) / 60) & "," & arr(i - 1) & ");") Dummy = SysCmd(acSysCmdSetStatus, i & ":" & arr(i - 1) & "(" & j & ")") Next j
Next i
Dummy = SysCmd(acSysCmdClearStatus)
WB.Close False XL.Quit
End Sub
Позже, результаты были усреднены.
Описания методов:
Метод ADODB recordset
Общее описание: Очень быстрый и мощный. Особенности: вы должны определить x и y координаты верхней левой ячейки, и в переменные n и m, переданные по ссылке вы получаете высоту и ширину полученного диапазона. Установите значение переменной Headers равной True, если вам нужны в заголовки столбцов. Этот метод - ошибко-независимый - ошибки игнорируется. Детали этого решения - ADODB recordset - позволяет вернуть значения полей записи запроса и поместить их в массив, который затем транспонируется и выводится в MS Excel Range . Требования: Требуются ссылки на библиотеку MS Excel object library (необязательно, - используется, толко для проверки синтаксиса. Вы можете не устанавиливать ссылку на Excel, описав переменную WS как Object) также требуется ссылка на библиотеку ActiveX Data Objects Library Преимущества: Быстрый, универсальный, надежный. Недостатки: Этот метод весьма замедлен необходимостью транспонировать матрицу, полученную методом getrows. К сожалению, getrows помещает значения в транспонированном виде. Если этого удастся избежать каким либо способом, скорость значительно увеличится. Code:
Public Function TXLOut (sql As String, Optional WS As Worksheet = Nothing, Optional ByRef x As Long = 1, Optional ByRef y As Long = 1, Optional ByRef n As Long = 1, Optional ByRef m As Long = 1, Optional Headers As Boolean = True) As Worksheet 'Turbo Version 'Notice, that you need References to ActiveX Data Objects Library and Microsoft Excel Objects Library Dim a As Variant Dim rs As New ADODB.Recordset Dim con As New ADODB.Connection Dim c() As Variant Dim i, j, l, k As Integer
' Here comes matrix transposition For k = 0 To UBound(a, 1) For j = 0 To UBound(a, 2) c(j, k) = a(k, j) Next j Next k
n = UBound(a, 2) + 1 m = UBound(a, 1) + 1
WS.Range(WS.Cells(y, x), WS.Cells(n + y - 1, m + x - 1)) = c
'Here columns headers are put if necessary If Headers Then WS.Range(WS.Cells(y, x), WS.Cells(n + y - 1, m + x - 1)).rows(1).Insert For j = 0 To m - 1 WS.Cells(y, j + x).Value = rs.Fields(j).Name Next j End If
rs.Close
Exit Function
whoops: Resume Next End Function
Метод DAO recordset
Общее описание: Фактически это - вариация версии ADO+recordset метода и как таковая имеет несколько недостатков. Особенности: Вы должны определить x и y - верхней левой ячейки, и в переменные n и m, вы получаете высоту и ширину полученного диапазона. Установите значение переменной Headers равной TRUE, если Вам нужны в заголовки столбцов. Этот метод - ошибко-независимый - ошибки игнорируется. Детали этого решения - DAO recordset - позволяет вернуть значения полей записи запроса и поместить их в массив, который затем транспонируется и выводится в диапазон ячеек Excel. Требования: Требуется ссылка на библиотеку MS Excel object library (необязательно, - только, чтобы иметь правильный синтаксис. Вы можете не устанавливать ссылку на EXCEL, описав переменную WS как Object) Преимущества: Не нуждается в ссылке на библиотеку ADO. На малом количестве строк (<50) показывает лучший результат (см. график). В этой процедуре сделаны некоторые изменения. Если Вы переносите большое количество данных (приблизительно 30000 строк для моей машины), Вы можете выйти за пределы памяти (out of memory), и даже если компьютер не зависнет, это будет медленней, чем сделать перенос 3 раза по 10000 записей. Так что эта функция проверяет количество записей и если их более 10000, выводит их по частям. Недостатки: Этот метод зависит от количества ошибок в рекордсете. В отличие от ADO recordset, метод GetRows библиотеки DAO, когда встречается ошибка в любом поле, прекращает работать и не генерирует никакой ошибки - данные потеряны, и Вы ничего об этом не знаете. По этому, вместо rs.getrows в этой процедуре использована автономную процедуру GetR, которая использует getrows, и в случае ошибок читает запись поле за полем.
Code:
Public Function XLOut(sql As String, Optional WS As Worksheet = Nothing, Optional ByRef x As Long = 1, Optional ByRef y As Long = 1, Optional ByRef n As Long = 1, Optional ByRef m As Long = 1, Optional Headers As Boolean = True) As Worksheet
Dim a As Variant Dim rs As Recordset Dim l, i, j As Integer
Set rs = CurrentDb.OpenRecordset(sql) If Not rs.EOF Then rs.MoveLast rs.MoveFirst End If
n = rs.RecordCount m = rs.Fields.Count
If n <= 10000 Then
a = GetR(rs, rs.RecordCount)
WS.Range(WS.Cells(y, x), WS.Cells(UBound(a, 1) + y, UBound(a, 2) + x)) = a Else
For i = 1 To n 10000 a = GetR(rs, 10000)
WS.Range(WS.Cells((i - 1) * 10000 + y, x), WS.Cells((i - 1) _ * 10000 + UBound(a, 1) + y, UBound(a, 2) + x)) = a Next i
a = GetR(rs, n Mod 10000) WS.Range(WS.Cells(n - (n Mod 10000) + y, x), WS.Cells(n + y, UBound(a, 2) + x)) = a
End If
If Headers Then WS.Cells(y, x).EntireRow.Insert For j = 0 To rs.Fields.Count - 1 WS.Cells(y, j + x).Value = rs.Fields(j).Name Next j End If
Set rs = Nothing
Set XLOut = WS End Function Function GetR(rs As Recordset, n As Long) As Variant Dim a As Variant Dim b() As Variant Dim c() As Variant Dim i, j, l, k As Integer Dim num As Integer Dim hnum As Integer On Error GoTo whoops l = rs.Fields.Count ReDim a(l - 1, 0) num = 0 While Not rs.EOF a = rs.GetRows(n)
If Not rs.EOF Then j = UBound(a, 2) + 1 ReDim Preserve a(l - 1, j) For i = 0 To l - 1 a(i, j) = rs.Fields(i).Value Next i rs.MoveNext End If
num = num + 1 ReDim Preserve b(num) b(num) = a Wend
ReDim c(n - 1, l - 1)
hnum = 0 For i = 1 To num For k = 0 To UBound(b(i), 2) For j = 0 To l - 1 'iiey c(hnum, j) = b(i)(j, k) Next j hnum = hnum + 1 Next k Next i
GetR = c
Exit Function whoops: ' Debug.Print "Recordset Error!" Resume Next
End Function
Метод OutputTo
Общее описание: Довольно быстро для выбранного количества строк - см. график и очень простой метод. Ошибки игнорируются. Требования: необходимо иметь сохраненный запрос "Bolvanka" (или с любым другим названием). Преимущества: Простой, быстрый, свободный от ошибок метод. Преимуществом можно считать и то, что Вы получаете готовый файл на диске. Недостатки: Вы можете вывести только один лист в один файл. Вы можете поместить результаты запроса только начиная с верхней левой ячейки листа Вы не можете вывести данные без заголовков.
Общее описание: Это, наверное, самый быстрый способ (см. график), но он имеет серьезные недостатки. Требования: нeобходимо иметь сохраненный запрос "Bolvanka" (или с любым другим названием). Преимущества: Наиболее быстрый, простой, вы получаете файл на диске. Недостатки: Вы можете поместить результаты запроса только начиная с верхней левой ячейки листа Если recordset содержит ошибку, Вы получите всплывающее сообщение об ошибке, которое я не смог подавить - так что это - едва ли хороший способ для автоматизации. Но я думаю, если предпринять меры к предотвращению ошибок и сборке файлов после вывода в одну рабочую книгу, этот способ будет самым быстрым, для небольшого количества строк.
Code:
> Function TDXLOut(sql As String) CurrentDb.QueryDefs("Bolvanka").sql = sql DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Bolvanka", "C:Test.xls", True End Function
Метод Copyfromrecordset
Общее описание: Это встроенный метод Excel для получения значений из recordset на рабочий лист. Требования: библиотека объектов MS Excel Перимущества: Простой. Данные могут быть помещены в любом месте страницы Недостатки: В Excel 97, метод принимает в качестве аргумента только DAO recordset. Как я уже упоминал, DAO recordset имеет очень неприятный дефект - при любой ошибке он обрезает данные до места ошибки, не выводя никаких сообщений об ошибке. Поэтому, если вы собираетесь использовать этот метод, вы должны проверять recordset на наличие ошибок перед или после вывода. Excel более поздних версий поддерживает ADO recordsets, который не содержит этого дефекта.
Code:
Function CFRXLOut(WS As Worksheet, sql As String) Dim rs As Recordset
Set rs = CurrentDb.OpenRecordset(sql) WS.Cells(3,2).CopyFromRecordset rs
End Function
Метод QueryTable
Общее описание: QueryTables - простой способ получить данные из Access в Excel с использованием пользовательского интерфейса Excel. Это можно сделать и программно. Требования: библиотека объектов MS Excel Преимущества: Это - лучший метод, если Вы имеете, скажем, шаблон, с большим количеством форматирования и небольшим количеством данных. Вы обновляете QueryTables, уничтожаете их и сохраняете под другим именем. Недостатки: Как правило файлы с External Data не принято перемещать с машины на машину или посылать через электронную почту - если кто - то случайно обновит таблицы запроса на машине, которая не имеет необходимых источников данных, он получит ошибку. По этому, если Вы планируете передавать этот файл, Вы должны сделать QueryTables ("name") .Delete - чтобы данные были сохранены в файле Excel. Кроме того, этот метод медленен (см. График).
Общее описание: При разработке этого метода, я думал, это - курьез, не более. Однако, полученные результаты показали, что это неожиданно хороший метод для небольшого (<500) количества записей. Требуются: ссылки на библиотеку MS Excel object library (необязательно, - нужно только, чтобы иметь правильный синтаксис. Вы можете не устанавливать ссылку на EXCEL, описав переменную WS как Object), библиотеку ActiveX Data Objects Library и MSForms Object library. Метод объединяет возможности ADO recordset, и MSForms Data Object. DataObject дает возможность взаимодействовать с буфером обмена (Clipboard). Мы заполняем буфер обмена строкой, где значения полей разделены CHR (9) и строки CHR (10), затем выполняем Paste. Есть способы ускорить эту процедуру, например использовать не DataObject, а API. Другой путь - использовать не заданный по умолчанию текстовый формат в SetText, а помещать в буфер обмена массив, что позволит на составлять строку. Преимущества: Быстро. Недостатки: Требуется 3 библиотеки. "умирает", если размер данных превышает 2 КБ (ограничения буфера обмена Windows).
Code:
Public Function CXLOut(sql As String, Optional WS As Worksheet = Nothing, Optional ByRef x As Long = 1, Optional ByRef y As Long = 1, Optional ByRef n As Long = 1, Optional ByRef m As Long = 1, Optional Headers As Boolean = True) As Worksheet 'Clipboard version Dim a As Variant Dim rs As New ADODB.Recordset Dim con As New ADODB.Connection Dim ors As Recordset 'Dim l, i, j As Integer Dim c As Variant Dim i, j, l, k As Integer Dim dum As String Dim ddo As New MSForms.DataObject
dum = "" Do dum = dum + CStr(rs(0)) For i = 1 To rs.Fields.Count - 1 dum = dum + Chr(9) + CStr(Nz(rs(i))) Next i dum = dum + Chr(10) j = j + 1 rs.MoveNext Loop While Not rs.EOF
n = j m = rs.Fields.Count
ddo.SetText (dum) ddo.PutInClipboard WS.Cells(1, 1).Activate WS.Paste 'WS.Range(WS.Cells(y, x), WS.Cells(n + y - 1, m + x - 1)) = Trans(a)
If Headers Then WS.Range(WS.Cells(y, x), WS.Cells(n + y - 1, m + x - 1)).rows(1).Insert For j = 0 To m - 1 WS.Cells(y, j + x).Value = rs.Fields(j).Name Next j End If
rs.Close
Exit Function whoops: Resume Next End Function
Использование RunCommand + Clipboard
Общее описание: Один из моих первых экспериментов в той области. Худший вариант из всех Требования: сохраненный запрос, Microsoft excel object library (Optional) Недостатки: Медленно и во время выполнения вы ничего не можете делать. Code:
Function SKXLOut(WS As Worksheet, sql As String) DoCmd.SetWarnings False CurrentDb.QueryDefs("Bolvanka").sql = sql DoCmd.OpenQuery "Bolvanka", acViewNormal RunCommand acCmdSelectAllRecords RunCommand acCmdCopy DoCmd.Close acQuery, "Bolvanka" WS.Paste WS.Cells(1, 1) DoCmd.SetWarnings True End Function
Результаты тестирования:
Что дальше ?
Представленная статья содержит результаты испытания только в их зависимости от кол-ва возвращенных строк. Однако некоторые методы зависят от типа данных, другие могут быть чувствительны к памяти, или скорости диска и т.д. Со временем, я намерен исследовать и эти зависимости. Также я открыт для любых добавлений и изменений моей "коллекции" и сообщений об ошибках. Пишите на
Этот e-mail защищен от спам-ботов. Для его просмотра в вашем браузере должна быть включена поддержка Java-script