Способы передачи данных из MS ACCESS в Excel

Источник: Zmey

Тестируемые методы:

Ниже приведен список методов с текстом кода и комментариями, преимуществами и недостатками:
Обратите внимание на следующее: во-первых, это - не все возможные методы, я с удовольствием приму и протестирую любой метод, не указанный здесь, во-вторых - не все методы до конца оптимизированы (я также буду рад любым предложениям по изменениям, направленным на улучшение работы приведенных способов), и наконец, возможно имеются другие доступные методы и способы в более поздних версиях 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

rs.Open sql, "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & CurrentDb.Name & ";", adOpenForwardOnly, adLockOptimistic

a = rs.GetRows()

ReDim c(UBound(a, 2), UBound(a, 1))

' 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" (или с любым другим названием).
Преимущества:
Простой, быстрый, свободный от ошибок метод.
Преимуществом можно считать и то, что Вы получаете готовый файл на диске.
Недостатки:
Вы можете вывести только один лист в один файл.
Вы можете поместить результаты запроса только начиная с верхней левой ячейки листа
Вы не можете вывести данные без заголовков.

Code:

Function OTXLOut(sql As String)

CurrentDb.QueryDefs("Bolvanka").sql = sql DoCmd.OutputTo acOutputQuery, "Bolvanka", acFormatXLS, "C:\Test.xls"

End Function

Метод TransferSpreadsheet

Общее описание:
Это, наверное, самый быстрый способ (см. график), но он имеет серьезные недостатки.
Требования: н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. Кроме того, этот метод медленен (см. График).

Code:

Function QTXLOut(WS As Worksheet, sql As String)
With WS.QueryTables.Add(Connection:=Array(Array( _
"ODBC;DBQ=" & CurrentDb.Name & ";Driver={Microsoft Access Driver (*.mdb)};Dri" _
), Array( _
"verId=25;FIL=MS Access;ImplicitCommitSync=Yes;MaxBufferSize=512;MaxScanRows=8;PageTimeout=5;SafeTransactions=0;Threads=3;UserCo" _
), Array("mmitSync=Yes;")), Destination:=WS.Range("A1"))
.sql = Array( _
sql _
)
.Refresh BackgroundQuery:=False
End With

End Function

Использование ADO + Clipboard

Общее описание:
При разработке этого метода, я думал, это - курьез, не более. Однако, полученные результаты показали, что это неожиданно хороший метод для небольшого (<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

rs.Open sql, "Driver={Microsoft Access Driver (*.mdb)};Dbq=" & CurrentDb.Name & ";", adOpenForwardOnly, adLockOptimistic

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

Результаты тестирования:

Что дальше ?

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