Range to recordset

Tested in Excel 365 (16.8730.2046) 64-bit. All links open in new tab.

More info here

 
 
  1. Public Function RangeToRecordset(ExcelFile As String, SheetName As String) As Recordset
  2. ' need to add the following reference:
  3. ' Microsoft ActiveX Data object...
  4.    Const adOpenStatic = 3
  5.     Const adLockOptimistic = 3
  6.     Const adCmdText = &H1
  7.     Dim SQL As String
  8.     If IsMissing(SheetName) Then SheetName = ActiveSheet.Name
  9.     SQL = "Select * FROM [" & SheetName & "$]"
  10.     ' you can use complex SQL query too:
  11.    'SQL = "Select * FROM [" & SheetName & "$] where Unit='store 1' and Product='orange'"
  12.    
  13.     Set objConnection = CreateObject("ADODB.Connection")
  14.     Set objRecordset = CreateObject("ADODB.Recordset")
  15.    
  16.     objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  17.         "Data Source=" & ExcelFile & ";" & _
  18.             "Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1;TypeGuessRows=0;ImportMixedTypes=Text"""
  19.    
  20.     objRecordset.Open SQL, _
  21.         objConnection, adOpenStatic, adLockOptimistic, adCmdText
  22.    
  23.     Set RangeToRecordset = objRecordset
  24. End Function
  25. ' you can use it like this:
  26. Sub main()
  27.     Dim rs As Recordset
  28.     Set rs = RangeToRecordset(ActiveWorkbook.FullName, ActiveSheet.Name)
  29.    
  30.     ' do something with the recordset
  31.    Debug.Print rs.RecordCount, rs.Fields.Count
  32.     Set rs = Nothing
  33. End Sub

Or another example where you can pass the SQL to the function:

 
 
  1. Public Function RangeToRecordset2(ExcelFile As String, StrSQL As String) As Recordset
  2. ' need to add the following reference:
  3. ' Microsoft ActiveX Data object...
  4.    Const adOpenStatic = 3
  5.     Const adLockOptimistic = 3
  6.     Const adCmdText = &H1
  7.     Dim objConnection As Connection
  8.     Dim objRecordset As Recordset
  9.    
  10.     Set objConnection = CreateObject("ADODB.Connection")
  11.     Set objRecordset = CreateObject("ADODB.Recordset")
  12.    
  13.     objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  14.         "Data Source=" & ExcelFile & ";" & _
  15.             "Extended Properties=""Excel 8.0;HDR=Yes;"";"
  16.    
  17.     objRecordset.Open StrSQL, _
  18.         objConnection, adOpenStatic, adLockOptimistic, adCmdText
  19.    
  20.     Set RangeToRecordset2 = objRecordset
  21. End Function
  22. ' you can use it like this:
  23. Sub main()
  24.     Dim rs As Recordset
  25.    
  26.     Set rs = RangeToRecordset2(ActiveWorkbook.FullName, "select * from [" & ActiveSheet.Name & "$]")
  27.    
  28.     ' do something with the recordset
  29.    Debug.Print rs.RecordCount, rs.Fields.Count, rs.Fields(0).Value
  30. End Sub

You can use this file to test the code

Add a Comment

Your email address will not be published. Required fields are marked *

This site uses Akismet to reduce spam. Learn how your comment data is processed.