Import from closed workbook in order of sheets ADODB - excel

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