Collect data from specific column from closed workbooks using ADO

[YasserKhalil]

I have no experience but which is more efficient .. and what's the difference between both of them?

I'd use the DAO object db to open the recordsets as well

That would be great to learn new skills from you, my tutor.

[HansV]

You can use either. In this situation, DAO is preferable since it gives you the sheets in the correct order.

DAO is also more convenient to use if you want to get data from an Access database; it is the "native" database engine for Microsoft Access.
On the other hand, ADO can connect to more types of files than DAO, and it has better support for text files than DAO.

In general, choose the one that is best suited for your purpose according to the above remarks; otherwise, simply use the one you're most comfortable with.

[HansV]

See Database.OpenRecordset method (DAO) to learn how to open a recordset in DAO.

[YasserKhalil]

Thanks a lot my tutor for the links .. but to be honest, I feel lost in microsoft links and I learn more from practical examples.
At any time, if you have plenty of time, can you show me how to translate such code to be used by DAO?

[HansV]

You mentioned that you want to learn, so you should figure it out yourself. The link that I provided contains several examples.

[YasserKhalil]

If possible I prefer that you put example as I can discuss you if there is something unclear.

[HansV]

Opening a recordset in DAO isn't difficult.

[YasserKhalil]

Is there a problem of using both DAO and ADODB in the same code?

[HansV]

It'll work, but it's inefficient: you're loading two separate database engines into memory where one would suffice.

[YasserKhalil]

Thank you for the information and I hope you provide me with a solution using DAO?

[HansV]

No, I will leave that as an exercise to you.

[YasserKhalil]

Believe me I have searched a lot for examples on google and all what I found is examples related to Access Databases and not excel .. and I tried to adapt the codes to work on excel but with no success.

[HansV]

Have you tried changing the declaration of rsHeaders from ADODB.Recordset to Object, and changing

Code: Select all

        Set rsHeaders = New ADODB.Recordset
        rsHeaders.Open Source:=strSQL, ActiveConnection:=cn, Options:=1

to

Code: Select all

        Set rsHeaders = db.OpenRecordset(strSQL)

[YasserKhalil]

Amazing. That worked very well. I will try with the rest although I preferred your style of coding to avoid any errors from my side.

[YasserKhalil]

Now this is the final code on my side but I couldn't deal with rsData

Code: Select all

Sub ImportFromClosedWorkbook()
', cn As ADODB.Connection
    Dim e, ws As Worksheet, rsHeaders As Object, b As Boolean, sFile As String, strSQL As String, iCol As Long
    sFile = ThisWorkbook.Path & "\Sample.xlsx"
    Dim con As Object
    Set con = CreateObject("DAO.DBEngine.120")
    'Dim rsData As ADODB.Recordset
    Dim rsData As Object
    '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
    Dim db As Object, i As Long
    Set db = con.OpenDatabase(sFile, False, True, "Excel 12.0 XMl;")
    For i = 0 To db.TableDefs.Count - 1
        sName = db.TableDefs(i).Name
        b = False
        strSQL = "SELECT * FROM [" & sName & "]"
        'Set rsHeaders = New ADODB.Recordset
        'rsHeaders.Open Source:=strSQL, ActiveConnection:=cn, Options:=1
         Set rsHeaders = db.OpenRecordset(strSQL)
        For iCol = 0 To rsHeaders.Fields.Count - 1
            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
            strSQL = "SELECT [" & e & "] FROM [" & sName & "]"
            'Set rsData = New ADODB.Recordset
            
            Set rsData = db.Execute(strSQL)
            ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1).CopyFromRecordset rsData
            rsData.Close
        End If
    Next i
    db.Close: Set db = Nothing
    Set con = Nothing
    'cn.Close: Set cn = Nothing
End Sub

What should I do to fix rsData part?

[HansV]

Amazing. That worked very well. I will try with the rest although I preferred your style of coding to avoid any errors from my side.

You could have done that yourself in 5 minutes if you had bothered to view the examples in the link that I provided...

[HansV]

You can do rsData the same way as rsHeaders!

[YasserKhalil]

Thank you very much for your patience
Here's the final code and I hope you will have a loo to see if there are any bugs

Code: Select all

Sub Test_ImportFromClosedWorkbook()
    ImportFromClosedWorkbook ThisWorkbook.Path & "\Sample.xlsx", Sheet1
End Sub

Sub ImportFromClosedWorkbook(ByVal sFile As String, ByVal ws As Worksheet)
    Dim e, con As Object, db As Object, rsHeaders As Object, rsData As Object, b As Boolean, strSQL As String, i As Long, iCol As Long
    Set con = CreateObject("DAO.DBEngine.120")
    Set ws = ThisWorkbook.ActiveSheet
    Set db = con.OpenDatabase(sFile, False, True, "Excel 12.0 XMl;")
    For i = 0 To db.TableDefs.Count - 1
        sName = db.TableDefs(i).Name
        b = False
        strSQL = "SELECT * FROM [" & sName & "]"
        Set rsHeaders = db.OpenRecordset(strSQL)
        For iCol = 0 To rsHeaders.Fields.Count - 1
            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
            strSQL = "SELECT [" & e & "] FROM [" & sName & "]"
            Set rsData = db.OpenRecordset(strSQL)
            ws.Range("A" & ws.Cells(Rows.Count, 1).End(xlUp).Row + 1).CopyFromRecordset rsData
            rsHeaders.Close: rsData.Close
        End If
    Next i
    db.Close
    Set con = Nothing: Set db = Nothing: Set rsHeaders = Nothing: Set rsData = Nothing
End Sub

[HansV]

That looks OK.