Import from closed workbook in order of sheets ADODB

Question

As to me, ADODB is something new for me that I am eager to learn. Here's a code that I tried my best but needs your ideas to make it appear more professional and more efficient. The problem in the code is that the data is grabbed from sheets in reverse order and not in the order of sheets. To make it clear, I have Sample.xlsx workbook with two sheets Sheet1 and New and the code is supposed to loop through t he sheets then search for specific header then to get the data from such a column. All this with the ADO approach. the code grabs the data from New sheet first then from Sheet1 .. While the order of the sheets is Sheet1 then New >> another point, how can I close the recordset properly. I mean is using .Close is enough or I have to set it to Nothing Set rs=Nothing.

    Sub ImportFromClosedWorkbook()
    Dim e, ws As Worksheet, cn As ADODB.Connection, rs As ADODB.Recordset, rsHeaders As ADODB.Recordset, b As Boolean, sFile As String, shName As String, strSQL As String, iCol As Long
    sFile = ThisWorkbook.Path & "\Sample.xlsx"
    'shName = "Sheet1"
    Dim rsData As ADODB.Recordset
    Set cn = New ADODB.Connection
    cn.Open ConnectionString:="Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & sFile & "';" & "Extended Properties=""Excel 12.0;HDR=YES;IMEX=1;"";"
    '--------
    Set ws = ThisWorkbook.ActiveSheet
    Set rs = cn.OpenSchema(20)
    Do While Not rs.EOF
        sName = rs.Fields("Table_Name")
        If Right(sName, 14) <> "FilterDatabase" Then
            sName = Left(sName, Len(sName) - 1)
            'Debug.Print sName
            b = False
            strSQL = "SELECT * FROM [" & sName & "$]"
            Set rsHeaders = New ADODB.Recordset
            rsHeaders.Open Source:=strSQL, ActiveConnection:=cn, Options:=1
            For iCol = 0 To rsHeaders.Fields.Count - 1
                'Debug.Print rsHeaders.Fields(iCol).Name
                For Each e In Array("Ref No", "Reference", "Number")
                    If e = rsHeaders.Fields(iCol).Name Then
                        b = True: Exit For
                    End If
                Next e
                If b Then Exit For
            Next iCol
        
            If b Then
                'Debug.Print e
            strSQL = "SELECT [" & e & "] FROM [" & sName & "$]"
            Set rsData = New ADODB.Recordset
            Set rsData = cn.Execute(strSQL)
            ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1).CopyFromRecordset rsData
               rsData.Close
                'here I am stuck of how to get the data from the found column
            End If
        
            'rs.Close
        End If
        rs.MoveNext
    Loop
    'rs.Close

    '------------------
    '    strSQL = "SELECT * FROM [" & shName & "$]"
    '    Set rs = New ADODB.Recordset
    '    Set rs = cn.Execute(strSQL)
    '    Range("A1").CopyFromRecordset rs
    rs.Close: Set rs = Nothing
    cn.Close: Set cn = Nothing
End Sub

Answer 1

the code grabs the data from New sheet first then from Sheet1 .. While the order of the sheets is Sheet1 then New

The tab order is an Excel feature. The Sheet names are extracted in alphabetical order when you use ADODB. This is the reason why you get New sheet first and then Sheet1.

Note: If the sheet names start with number or have spaces then they are given a priority first. Few examples

Example 1

Sheets names: 1, Sheet1, 1Sheet4, She et3, Sheet5

Returned as

'1$'
'1Sheet4$'
'She et3$'
Sheet1$
Sheet5$

Example 2

Sheets names: Sheet2, Sheet5, She et3, Sheet1, Sheet4

Returned as

'She et3$'
Sheet1$
Sheet2$
Sheet4$
Sheet5$

Example 3

Sheets names: 1, Sheet1, 2, Sheet2, 3, Sheet3

Returned as

'1$'
'2$'
'3$'
Sheet1$
Sheet2$
Sheet3$

Alternative to ADODB

If you want to extract the names of the sheets in the tab order then you can use DAO as shown by Andrew Poulsom in THIS link. Posting the code here in case the link dies...

Sub GetSecondSheetName()
'   Requires a reference to Microsoft DAO x.x Object Library
'   Adjust to suit
    Const FName As String = "P:\Temp\MrExcel\Temp\SheetNames.xls"
    Dim WB As DAO.Database
    Dim strSheetName As String
    Set WB = OpenDatabase(FName, False, True, "Excel 8.0;")
'   TableDefs is zero based
    strSheetName = WB.TableDefs(1).Name
    MsgBox strSheetName
    WB.Close
End Sub

Close is enough or I have to set it to Nothing Set rs=Nothing.

No you do not have to set it to nothing. VBA cleans it automatically when it exits the prodecure. But yes it is a good practice to flush the toilet.

Interesting Read:

You may want to read the post by @GSerg in the below link...

When should an Excel VBA variable be killed or set to Nothing?

For it to work with XLSX, use this (Requires a reference to Microsoft Office XX.XX Access database engine Object Library)

Option Explicit

'~~> Change this to the relevant file name
Const FName As String = "C:\Users\routs\Desktop\Delete Me later\TEXT.XLSX"

Sub Sample()
    'Requires a reference to Microsoft Office XX.XX Access database engine Object Library
    
    Dim db As DAO.Database
    Set db = OpenDatabase(FName, False, False, "Excel 12.0")
    
    Dim i As Long
    For i = 0 To db.TableDefs.Count - 1
        Debug.Print db.TableDefs(i).Name
    Next i
    
    db.Close
End Sub

In Action

Answer 2

@Siddharth Rout you have inspired me how to search for such new topic for me and I could use such a code to list all the worksheets in the order of tab using DAO but with late binding ( I am curious to know how to use early binding as I tried but with no success)

Sub Get_Worksheets_Using_DAO()
    Dim con As Object, db As Object, sName As String, i As Long
    Set con = CreateObject("DAO.DBEngine.120")
    sName = ThisWorkbook.Path & "\Sample.xlsx"
    Set db = con.OpenDatabase(sName, False, True, "Excel 12.0 XMl;")
    For i = 0 To db.TableDefs.Count - 1
        Debug.Print db.TableDefs(i).Name
    Next i
    db.Close: Set db = Nothing: Set con = Nothing
End Sub