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
  5. Public Function RangeToRecordset(ExcelFile As String, StrSQL As String, Optional HasHeader = "Yes") As Recordset
  6. ' need to add the following reference:
  7. ' Microsoft ActiveX Data object...
  8.    Const adOpenStatic = 3
  9.     Const adLockOptimistic = 3
  10.     Const adCmdText = &H1
  11.    
  12.     Set objConnection = CreateObject("ADODB.Connection")
  13.     Set objRecordset = CreateObject("ADODB.Recordset")
  14.    
  15.     objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
  16.         "Data Source=" & ExcelFile & ";" & _
  17.             "Extended Properties=""Excel 8.0;HDR=" & HasHeader & ";"";"
  18.    
  19.     objRecordset.Open StrSQL, _
  20.         objConnection, adOpenStatic, adLockOptimistic, adCmdText
  21.    
  22.     Set RangeToRecordset = objRecordset
  23. End Function
  24. Public Function CloseConnectionAndRecordset(cn As Connection, rs As Recordset)
  25.     Set rs = Nothing
  26.     Set cn = Nothing
  27. End Function

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.