excelvba

Import from closed workbook in order of sheets ADODB


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

Solution

  • 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

    enter image description here