PDA

View Full Version : مقاله: انواع روشهای انتقال اطلاعات از Access به Excel



شاپرک
شنبه 21 دی 1387, 13:49 عصر
Ways to transfer MS Access data to Excel:

Putting data from Access to Excel appears to become common task in VBA programming. Trying to make this transfer fast, reliable and universal I've come across some interesting methods and specifics, which I want to share in hope to receive new ideas and to help others to not repeat my mistakes.
Methods being tested:

Below the list of methods with code and comments, advantages and disadvantages:
Notice first, that these are not all the possible methods, i would gladly accept and test any method, not included here, second - not all the methods optimized to their best performance (I will also gladly accept any modifications on that), and, finally, there may be more possible methods and different performances in later versions of MS Office - I was limited by Office 97 only.

* ADODB recordset method
* DAO recordset method
* OutputTo method
* TransferSpreadsheet method
* Copyfromrecordset method
* QueryTable method
* ADO + Clipboard method
* RunCommand + Clipboard method

* Test Results


The task:

The task was to test performance of various methods of putting result of given sql string to excel worksheet. Let's notice, that from the beginning not all procedures are equal in that kind of testing, since some of them (for example, OutputTo), create an xls file on disk, while other (RunCommand for example) need that file to be saved after creation. On the other hand, first kind of methods can't produce workbook with multiple sheets or put data in specified place of worksheet - you need to "collect" sheets in one workbook after putting them to disk. Also different methods vary in their sensitivity to mistakes, possible present in recordset.
So the task formulated as to put the result of sql string with errors into single worksheet - as soon as data is on a worksheet, task is completed.
Testing Method:

Microsoft Access/Excel 97 SR-2 Under WinNT 4.0 on Intel Pentium IV 2200, 256MB, 30GB machine was used to do the tests. Data transferred from local table, contained 13 fields and 10000 records to Excel worksheet just creatrd.
Testing procedure:



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 used to generate division by zero error in recordset

x = 1
y = 1

For j = 1 To 10
a = timer

Call SKXLOut(WS, sql)
'Here the tested procedure is called 10 times

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

Later, the results were averaged.
Methods:

ADODB recordset method

General Description:
Very fast and powerful.
Features: you have to specify x and y - top left cell, and in n and m variables you receive the height and width of range received. Set Headers variable to true if you need column headers.
This method is error independent - error values just ignored.
The components of this solution are ADODB recordset - used to retrieve records values from query and put them into array, and then array is being transposed and put to MS Excel Range.
Requirements:
Requires references to MS Excel object library (optional indeed, - just to have the correct syntax. You can get rid of it, receiving WS as Object) and ActiveX Data Objects Library
Advantages:
Fast, adjustable, reliable.
Disadvantages:
This method is much slowed by the necessity to transpose matrix received by getrows. Unfortunately, getrows puts values in transposed way. If it can be avoided some way, speed will increase much.
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 method

General Description:
Actually this is a previous version of ADO+recordset method and as such have some drawbacks.
Features: you have to specify x and y - top left cell, and in n and m variables you receive the height and width of range received. Set Headers variable to true if you need column headers.
This method is error independent - error values of cell just ignored.
The components of this solution are DAO recordset - used to retrieve records values from query and put them into array, and then array is being transposed and put to MS Excel Range.
Requirements:
Requires references to MS Excel object library (optional indeed - just to have the correct syntax. You can get rid of it, sending WS as Object)
Advantages:
Doesn't need references to ADO library.
On low number rows (<50) shows best performance (see graph).
In this procedure some useful modifications are made. If you transfer large amount of data (about 30000 rows in my machine) you can run out of memory, and even if you don't it's slower, then do it 3 times by 10000. So this one function is checking - is there more then 10000 rows and breaks them apart if necessary.
Disadvantages:
This method is dependent on number of errors. Unlike the ADO recordset, DAO get rows method, when meets error in any field stops working and generates no error - the data is lost, and you know nothing about this. So, instead of rs.getrows in this procedure used stand alone procedure GetR, which uses getrows, and in case of errors, read the record field by field and then continues.
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 method


General Description:
Pretty fast on its range of rows count - see graph and very simple method.
Errors are ignored.
Requirements: need to have dummy query "Bolvanka" (or any name).
Advantages:
Simple, fast, error-free method.
There may also considered as advantage, that you got file on disk already
Disadvantages:
You can output one sheet in time to one file.
You can put result of query only in top left cell of the sheet
You can't output without headers.
Code:


Function OTXLOut(sql As String)

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

End Function



TransferSpreadsheet method

General Description:
That seems to be fastest way of all (see graph), but there are serious disadvantages.
Requirements: need to have dummy query "Bolvanka" (or any name).
Advantages:
Fastest, simple, you get file on disk.
Disadvantages:
You can put result of query only in top left cell of the sheet
If recordset contains an error, you have pop-up prompt, which I couldn't suppress - so it's hardly can be automated. But I think, if something will be done to prevent errors and to collect files after outputs to one worksheet, it still will remain fastest way, at least at some range of rows number.
Code:


Function TDXLOut(sql As String)
CurrentDb.QueryDefs("Bolvanka").sql = sql
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel97, "Bolvanka", "C:\Test.xls", True
End Function


Copyfromrecordset method

General Description:
This is built into excel method to get recordset values on worksheet
Requerements: MS Excel object library
Advantages:
Simple. Can put data anywhere on the page
Disadvantages:
In excel 97 you can use only DAO recordset in this method. As I mentioned, DAO recordset has very unpleasant bug - if there's any error, it quits and shows nothing. So, if you want to use this method, you must check recordset for errors either before or after output. Excel of later versions support ADO recordsets, which are free of this bug.
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 method

General Description:
QueryTables are simple way to get data from Access to excel using Excel UI. However they can be created programmatically from Access.
Requirements: MS Excel object library
Advantages:
It's the best method, if you have, say, template, with lots formatting and few data.
You refresh, kill QueryTables and save as different name. Very fast in that case.
Disadvantages:
That's not a good practice to move files with query tables from machine to machine or send thru e-mail - if someone accidentally refreshes query tables on machine which hasn't DSN required, he'll get an error. So if you plan to move that file, you have to do QueryTables("name").Delete - so that the data is only thing left. Besides, this method is slow.
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;Ma xScanRows=8;PageTimeout=5;SafeTransactions=0;Threa ds=3;UserCo" _
), Array("mmitSync=Yes;")), Destination:=WS.Range("A1"))
.sql = Array( _
sql _
)

.Refresh BackgroundQuery:=False

End With

End Function


ADO + Clipboard method

General Description:
When developing this method, I thought it's an artifact - curious, nothing more. However, performance it showed appeared unexpected good on low (<500) rows.
Requirements: Requires references to MS Excel object library (optional indeed - just to have the correct syntax. You can get rid of it, sending WS as Object) , ActiveX Data Objects Library and MSForms Object library.
Method combines ADO recordset, and MSForms Data Object. DataObject used to interact with clipboard. We fill the clipboard with string, where values divided by chr(9) and rows by chr(10), then paste. There are ways to speed up this procedure, for example not using DataObject, but API. Another possible way - using not default text format in SetText, that may allow not compose string, but put the array to the clipboard.
Advantages:
Fast.
Disadvantages:
Needs 3 libraries, dies if data size exceeds 2 kB (windows clipboard limitation).
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 method

General Description:
One of my first experiment in that area. Worst performance of all
Requirements: dummy query
Advantages: Microsoft excel object library (Optional)
Disadvantages:
Slow and you can't do anything while it works.
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


Result Graph:


What next?

Present article contains testing results only in their dependence on number of rows returned. However some methods are data-type dependent, other may be sensitive to memory or disk speed e.t.c. I'm going to test them in that way. Also I stay open to any additions and modifications to my "collection" and bugs report. Email me on zmey2@1977.ru

Best regards,
Zmey2.