Range to recordset

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

More info here

 
 
  1. Option Explicit
  2.  
  3. Public objConnection As Connection
  4. Public objRecordset As Recordset
  6. Public Function RangeToRecordset(ExcelFile As String, StrSQL As String, Optional HasHeader = "Yes") As Recordset
  7. ' need to add the following reference:
  8. ' Microsoft ActiveX Data object...
  9.    Const adOpenStatic = 3
  10.     Const adLockOptimistic = 3
  11.     Const adCmdText = &H1
  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=" & HasHeader & ";"";"
  19.    
  20.     objRecordset.Open StrSQL, _
  21.         objConnection, adOpenStatic, adLockOptimistic, adCmdText
  22.    
  23.     Set RangeToRecordset = objRecordset
  24. End Function
  26. Public Function CloseConnectionAndRecordset(Optional cn As Connection, Optional rs As Recordset)
  27.     If IsMissing(cn) Then Set cn = objConnection
  28.     If IsMissing(rs) Then Set rs = objConnection
  29.    
  30.     Set cn = Nothing
  31.     Set rs = Nothing
  32. End Function
  33.  

You can use it like this:

 
 
  1. Sub main()
  2.     Dim rs As Recordset
  3.     Dim i, FieldNames
  4.    
  5.     Set rs = RangeToRecordset(ActiveWorkbook.FullName, "select * from [" & ActiveSheet.Name & "$]")
  6.    
  7.     ' do something with the recordset:
  8.    
  9.     ' get header
  10.    For i = 0 To rs.Fields.Count - 1
  11.         FieldNames = FieldNames & rs.Fields(i).Name & "|"
  12.     Next i
  13.     ' paste header
  14.    Range(Cells(1, 13), Cells(1, rs.Fields.Count + 13)).Value = Split(FieldNames, "|")
  15.     ' paste data
  16.    Range("M2").CopyFromRecordset rs
  17.    
  18.     Debug.Print rs.RecordCount, rs.Fields.Count
  19.    
  20.     ' free memory
  21.    CloseConnectionAndRecordset objConnection, objRecordset
  22. End Sub

 

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.