View Full Version : Displaying an SQL Select Statement Help

08-27-2013, 01:15 PM
I need some help with this query. Is their a way to shorten it (Maybe Limit) or an error in the code? It runs, but runs extremely slowly. I takes like 5 whole minutes and nearly freezes my computer. It ends with 8370 total rows aftwerword. Can anyone help me improve the start up time?

Firstly, I am using .accdb files, so please don't help with code that only works with .mdb. That has already happend many times before :(. Also, if there is a limit, there needs to be a where clause and a limit (which hasn't worked in this program).

Option Explicit
Sub Access_Data()
'Requires reference to Microsoft ActiveX Data Objects xx Library

'"SELECT * FROM Data_All", "C:\Users\zachk\Desktop\Strats 2011.01.accdb

Dim Cn As ADODB.Connection, Rs As ADODB.Recordset
Dim MyConn, sSQL As String

Dim Rw As Long, Col As Long, c As Long
Dim MyField, Location As Range

'Set destination
Set Location = [B2]
'Set source
MyConn = "C:\Users\zachk\Desktop\Strats 2011.01.accdb"
'Create query
sSQL = "SELECT Trust FROM Data_All WHERE BondIssue='C03B1T';"

'Create RecordSet
Set Cn = New ADODB.Connection
With Cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
Set Rs = .Execute(sSQL)
End With

'Write RecordSet to results area
Rw = Location.Row
Col = Location.Column
c = Col
Do Until Rs.EOF
For Each MyField In Rs.Fields
Cells(Rw, c) = MyField
c = c + 1
Next MyField
Rw = Rw + 1
c = Col
Set Location = Nothing
Set Cn = Nothing
End Sub

Please someone help me out! Thanks!

08-27-2013, 02:57 PM
Check out the Worksheet's QueryTable Object. It is designed to use ADODB and is probably an order of magnitude faster than saving the results to a worksheet Range

Kenneth Hobs
08-27-2013, 04:16 PM
I don't understand why you started another thread.

Talk about slow, when I was running an environmental program in 1990 or so, I bought a math coprocessor for my IBM 8088. It took a week to run. Same thing for simple ray tracing.

Your slow issue is because you are writing one cell value at a time. There is nothing wrong with that though it is not optimal. After each write, the whole spreadsheet recalculates if you have autocalculate on. It also refreshes the screen after each recalculation where data is changed. My routine has helped many people. Parts of it can be used but putting SpeedOn and SpeedOff in their own module makes them easy to use. Because of this common "slow" issue I wrote: http://vbaexpress.com/kb/getarticle.php?kb_id=1035

Why get hung up on MDB issues? I told you in your other thread that the ACCB files needed a separate connection string. You will still be the ADO object so many of those MDB examples should be like gold nuggets for you. I also posted an example ACCB method in the other thread that used GetRows.

I see nothing wrong with your approach if you use my speed routines to handle the "speed" issue. There are many ways to do these kinds of things of course. The ADO CopyFromRecordset seems ideal for you. The ADO GetRows method puts the recordset into an array which is good too. Both of these methods are shown below:


Option Explicit
'Connection Strings, http://www.connectionstrings.com/


Sub ADO()
' Set Reference in Tools to: Microsoft ActiveX Data Objects 2.x Library
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection
Dim RecordSet As ADODB.RecordSet
Dim Col As Integer, Row As Long, s As String

' Database information
DBFullName = ActiveWorkbook.Path & "\NWind2003.mdb"
If Dir(DBFullName) = "" Then Exit Sub

'Clear any existing data from activesheet

' Open the connection
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.Jet.OLEDB.4.0; "
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct

' Create RecordSet
Set RecordSet = New ADODB.RecordSet
' Record locking
RecordSet.CursorType = adOpenKeyset
RecordSet.LockType = adLockOptimistic

With RecordSet
' Filter
'Src = "SELECT * FROM Products WHERE ProductName = 'Watch' "
'Src = Src & "and CategoryID = 30"
Src = "SELECT Orders.CustomerID, Orders.OrderDate " & _
"FROM Orders " & _
"WHERE (((Orders.OrderDate) " & _
"Between #8/1/1994# and #8/30/1994#))"
RecordSet.Open Source:=Src, ActiveConnection:=Connection

' Write the field names
For Col = 0 To .Fields.Count - 1
Range("A1").Offset(0, Col).Value = RecordSet.Fields(Col).Name
Next Col

' Write the recordset
Range("A1").Offset(1, 0).CopyFromRecordset RecordSet
Dim a As Variant
a = RecordSet.GetRows
MsgBox LBound(a), , UBound(a)
MsgBox a(0), , a(1)

If .RecordCount < 1 Then GoTo endnow
For Row = 0 To (.RecordCount - 1)
'Debug.Print CStr(.Fields(Row).Value)
Next Row
End With
Set RecordSet = Nothing
Set Connection = Nothing
End Sub