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 :
> Take a look here:
>
> http://www.xl-expert.com/html_pages/...ity_Excel.html
>
> for a demo
>
> "Niranjan" wrote:
>
> > How to query Excel Dats Using SQL query?
Bookmarks