En cuanto a mí, ADODB es algo nuevo para mí que estoy ansioso por aprender. Aquí hay un código que hice lo mejor que pude, pero necesita sus ideas para que parezca más profesional y más eficiente. El problema del código es que los datos se obtienen de las hojas en orden inverso y no en el orden de las hojas. Para que quede claro, tengo Sample.xlsx libro de trabajo con dos hojas Sheet1 y New y se supone que el código recorre las hojas, luego busca un encabezado específico y luego obtiene los datos de tales una columna. Todo esto con el enfoque ADO. el código toma los datos de la Nueva hoja primero y luego de la Hoja1 .. Si bien el orden de las hojas es Hoja1 y luego Nuevo >> otro punto, ¿cómo puedo cerrar el juego de registros correctamente? Quiero decir, usar .Close es suficiente o tengo que configurarlo en 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
4
YasserKhalil 12 sep. 2020 a las 20:48

2 respuestas

La mejor respuesta

el código toma los datos de Nueva hoja primero y luego de Hoja1 .. Mientras que el orden de las hojas es Hoja1 y luego Nueva

El orden de tabulación es una función de Excel. Los nombres de las hojas se extraen en orden alfabético cuando utiliza ADODB. Esta es la razón por la que obtienes New sheet primero y luego Sheet1.

Nota : si los nombres de las hojas comienzan con un número o tienen espacios, primero se les da prioridad. Pocos ejemplos

Ejemplo 1

Nombres de hojas: 1, Sheet1, 1Sheet4, She et3, Sheet5

Devuelto como

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

Ejemplo 2

Nombres de hojas: Hoja2, Hoja5, Ella et3, Hoja1, Hoja4

Devuelto como

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

Ejemplo 3

Nombres de hojas: 1, Hoja1, 2, Hoja2, 3, Hoja3

Devuelto como

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

Alternativa a ADODB

Si desea extraer los nombres de las hojas en el orden de tabulación, puede usar DAO como lo muestra Andrew Poulsom en ESTE enlace. Publicando el código aquí en caso de que el enlace muera ...

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

Cerrar es suficiente o tengo que establecerlo en Nothing Set rs = Nothing.

No, no tienes que configurarlo en nada. VBA lo limpia automáticamente cuando sale de prodecure. Pero sí, es una buena práctica tirar la cadena del inodoro.

Lectura interesante:

Es posible que desee leer la publicación de @GSerg en el siguiente enlace ...

¿Cuándo se debe eliminar una variable de Excel VBA o establecerla en Nada?

Para que funcione con XLSX, use esto ( Requiere una referencia a la biblioteca de objetos del motor de base de datos de Microsoft Office XX.XX Access )

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

En acción

enter image description here

3
Siddharth Rout 13 sep. 2020 a las 08:22

@Siddharth Rout me ha inspirado cómo buscar un tema tan nuevo para mí y podría usar ese código para enumerar todas las hojas de trabajo en el orden de la pestaña usando DAO pero con enlace tardío (tengo curiosidad por saber cómo usar el enlace temprano como lo intenté pero sin éxito)

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
2
YasserKhalil 13 sep. 2020 a las 03:48