How to query Excel Data Using SQL?

  • Thread starter Thread starter Guest
  • Start date Start date
Patrick,

is there a specific reason why you use the MSDASQL provider?

it seems a (little bit ) slower then going straight to Jet using a
connection string like:

m_con.Open "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel
8.0;Data Source=" & m_sDatabase


Also When using ADO on excel files you should always check that the
queried workbook is not open as (known bug, leaks memory).
See http://support.microsoft.com/kb/319998/EN-US


I've adapted your demo as follows and included some handy functions :)

Option Explicit

Dim m_sDatabase As String
Dim m_con As ADODB.Connection
Dim m_rst As ADODB.Recordset

Private Sub Class_Initialize()
Set m_con = New ADODB.Connection
Set m_rst = New ADODB.Recordset
End Sub
Private Sub Class_Terminate()
If m_con.State Then m_con.Close
If m_rst.State Then m_rst.Close
Set m_rst = Nothing
Set m_con = Nothing
End Sub

Public Sub Initialise(sDatabase As String)
Dim wkb As Workbook, sErr$

On Error Resume Next
Set wkb = Workbooks(Dir(sDatabase))
On Error GoTo oops
m_sDatabase = sDatabase

If Dir(sDatabase) = "" Then
Err.Raise 1
ElseIf Not wkb Is Nothing Then
Err.Raise 2
Else
m_con.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Extended Properties=Excel 8.0;Data Source=" & m_sDatabase
End If
Exit Sub
oops:
Select Case Err.number
Case 1: sErr = "Unable to locate Database"
Case 2: sErr = "Querying an open workbook is not allowed"
Case Else: sErr = "Unable to connect to database"
End Select
Err.Raise 1, "Database Loader", sErr & vbCrLf & sDatabase
End Sub

Public Function GetData(sRange As String, Optional sWHERE As String)
With m_rst
If .State Then .Close
.Open "SELECT * from [" & sRange & "] " & _
IIf(sWHERE <> "", "WHERE " & sWHERE, ""), m_con, adOpenStatic
GetData = GetRowsTransposed
.Close
End With
End Function

Public Function GetHeaders(sRange As String)
Dim vGH, i&
If m_rst.State Then m_rst.Close
With m_rst
If .State Then .Close
.Open "SELECT TOP 1 * from [" & sRange & "] ", m_con, adOpenStatic
If Not .EOF Then
ReDim vGH(1 To 1, 1 To .Fields.Count)
For i = 1 To .Fields.Count
vGH(1, i) = .Fields(i - 1).Name
Next
End If
GetHeaders = vGH
.Close
End With
End Function

Private Function GetRowsTransposed()
'Transposes the 0based GetRows Array to a 1based Variant.
Dim vGR, vGA, r&, f&
If Not m_rst.EOF Then
vGR = m_rst.GetRows
ReDim vGA(1 To UBound(vGR, 2) + 1, 1 To UBound(vGR, 1) + 1)
For r = 0 To UBound(vGR, 2)
For f = 0 To UBound(vGR, 1)
If Not IsNull(vGR(f, r)) Then vGA(r + 1, f + 1) = vGR(f, r)
Next
Next
GetRowsTransposed = vGA
End If
End Function


--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam


Patrick Molloy wrote :
 
ok already

I updated my web page. I didn't before because it was (a) 4 years old and
(b) never viewed.

I appreciate KeepItCool's class , however, I have deliberately kept the
example simple so that less experienced VBA coders can get a handle on the
core stuff.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Back
Top