Creating a recordset over a range
Realised my first example did not allow SQL after the table name...
This is a better version.
Tim.
'###############################
Option Explicit
Sub Tester()
Dim rs As ADODB.Recordset
Dim iRow As Integer
Dim sSQL As String
sSQL = "select col2, count(col2) as v from @ group by col2"
Set rs = GetRecords(Selection, sSQL)
If Not rs Is Nothing Then
If Not rs.EOF And Not rs.BOF Then
ActiveSheet.Range("A20").CopyFromRecordset rs
Else
MsgBox "No records found"
End If
End If
End Sub
Function GetRecords(rng As Range, sSQL As String) As ADODB.Recordset
Const S_TEMP_TABLENAME As String = "SQLtempTable"
Dim oConn As New ADODB.Connection
Dim oRS As New ADODB.Recordset
Dim sPath
'name the selected range
On Error Resume Next
ActiveWorkbook.Names.Item(S_TEMP_TABLENAME).Delete
If Err.Number < 0 Then Err.Clear
On Error GoTo haveError
ActiveWorkbook.Names.Add Name:=S_TEMP_TABLENAME, RefersToLocal:=rng
sPath = ThisWorkbook.Path & "\" & ThisWorkbook.Name
oConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sPath & _
";Extended Properties=""Excel 8.0;HDR=Yes"""
oRS.Open Replace(sSQL, "@", S_TEMP_TABLENAME), oConn
Set GetRecords = oRS
Exit Function
haveError:
MsgBox Err.Description
Set GetRecords = Nothing
End Function
"James" wrote in message
...
All,
Would be grateful for any help on the following...
I need to create a recordset over an excel range and use bits of it
(i.e.
SELECT DISTINCT ColOneName FROM rst) as the source for lists on a
user form.
Have tried creating the fields and iterating through each row to
create it
but it takes too long. Any ideas?
Thanks in advance,
James
|