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

Обсудить статью на форуме: http://zmey.1977.ru/phorum/viewtopic.php?t=4

New!=>> Ловля блох. Эффективная обработка ошибок в проектах Access

См также: Ms Excel Fast Formatting and Outlining using Autofilter (английский вариант)

Ways to transfer MS Access data to Excel:(английский вариант)

Перенос данных из 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

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


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



Что дальше ?

Представленная статья содержит результаты испытания только в их зависимости от кол-ва возвращенных строк. Однако некоторые методы зависят от типа данных, другие могут быть чувствительны к памяти, или скорости диска и т.д. Со временем, я намерен исследовать и эти зависимости. Также я открыт для любых добавлений и изменений моей "коллекции" и сообщений об ошибках. Пишите на zmey2@1977.ru

 

© Andrew Semenov 2003
All rights reserved