Abrir un archivo Excel y leer datos del mismo es relativamente sencillo, pero puede ser más interesante realizar el intercambio de datos sin recurrir a abrir el programa asociado.

Microsoft permite realizar este intercambio mediante varias tecnologías, entre ellas ADO (hay detractores al respecto).

Hacerlo a través de Excel no resulta del todo simple, pero mediante estas rutinas pueden llevarse a cabo las tareas principales:

Option Explicit

Private Sub GetSheetNames2(ByRef szFullName As String, ByRefaszSheetList() As String)

    Dim bIsWorksheet As Boolean
    Dim objConnection As ADODB.Connection
    Dim rsData As ADODB.Recordset
    Dim lIndex As Long
    Dim szConnect As String
    Dim szSheetName As String

    Erase aszSheetList()
    
    Dim ExcelVersion As Integer
    ExcelVersion = VBA.Val(Application.Version)
    If ExcelVersion < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & szFullName & ";Extended Properties=Excel 8.0;"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & szFullName & ";Extended Properties=Excel 8.0;"
    End If

    Set objConnection = New ADODB.Connection
    objConnection.Open szConnect
    Set rsData = objConnection.OpenSchema(adSchemaTables)

    Do While Not rsData.EOF
        bIsWorksheet = False
        szSheetName = rsData.fields("TABLE_NAME").Value
        If Right$(szSheetName, 1) = "$" Then
            ''' This is a simple sheet name. Remove the trailing "$" and continue.
            szSheetName = Left$(szSheetName, Len(szSheetName) - 1)
            bIsWorksheet = True
        ElseIf Right$(szSheetName, 2) = "$'" Then
            ''' This is a sheet name with spaces and/or special characters.
            ''' Remove the right "&'" characters.
            szSheetName = Left$(szSheetName, Len(szSheetName) - 2)
            ''' Remove the left single quote character.
            szSheetName = Right$(szSheetName, Len(szSheetName) - 1)
            bIsWorksheet = True
        End If
        If bIsWorksheet Then
            ''' Embedded single quotes in the sheet name will be doubled up.
            ''' Replace any doubled single quotes with one single quote.
            szSheetName = Replace$(szSheetName, "''", "'")
            ''' Load the processed sheet name into the array.
            ReDim Preserve aszSheetList(0 To lIndex)
            aszSheetList(lIndex) = szSheetName
            lIndex = lIndex + 1
        End If
        rsData.MoveNext
    Loop

    rsData.Close
    Set rsData = Nothing
    objConnection.Close
    Set objConnection = Nothing

End Sub

Public Function GetSheetsNames(strFileName As String) AsCollection
    'Needs a reference to:
    'Microsoft ActiveX Data Object X.X Library
    'Microsoft ADO Ext. X.X for DLL and Security
    
    Dim tbl As ADOX.Table
    Dim sSheet As String
    Dim Col As New Collection
    
    Dim objConn As ADODB.Connection
    Set objConn = New ADODB.Connection
    objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0" & ";" & _
                 "Data Source=" & strFileName & ";" & _
                 "Extended Properties=Excel 8.0;"
    
    Dim objCat As ADOX.Catalog
    Set objCat = New ADOX.Catalog
    Set objCat.ActiveConnection = objConn
    
    For Each tbl In objCat.Tables
        sSheet = tbl.Name
        sSheet = Application.Substitute(sSheet, "'", "")
        sSheet = Left(sSheet, InStr(1, sSheet, "$", 1) - 1)
        On Error Resume Next
        Col.Add sSheet, sSheet
        On Error GoTo 0
    Next tbl
    Set GetSheetsNames = Col
    objConn.Close
    Set objCat = Nothing
    Set objConn = Nothing

End Function

Public Function ReadDataFromWorkbook(ByVal SourceFile AsString, ByVal SourceRange As String) As Variant
' Requiere una referencia a Microsoft ActiveX Data Objects library (Microsoft ActiveX Data Objects x.x Object Library)
' Si SourceRange es una referencia a un rango, la función sólo devuelve datos de la primera hoja en SourceFile
' Si SourceRange es un nombre de referencia la función puede devolver datos de cualquier hoja en SourceFile
' SourceRange must include the range headers
' examples:
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:A21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "A1:B21")
' varRecordSetData = ReadDataFromWorkbook("C:\FolderName\SourceWbName.xls", "DefinedRangeName")
    Dim dbConnection As ADODB.Connection, rs AsADODB.Recordset
    Dim dbConnectionString As String
    
    Set dbConnection = New ADODB.Connection
    On Error GoTo InvalidInput
    'dbConnectionString = "DRIVER={Microsoft Excel Driver (*.xls)};ReadOnly=1;DBQ=" & SourceFile
    'dbConnection.Open dbConnectionString ' Abre una conexión a la base de datos
    
    With dbConnection
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .ConnectionString = "Data Source=" & SourceFile & ";" & _
        "Extended Properties=Excel 8.0;"
        .Open
    End With
        
    Set rs = dbConnection.Execute("[" & SourceRange & "]")
    On Error GoTo 0
    ReadDataFromWorkbook = rs.GetRows ' Devuelve una matriz de dos dimensiones con todos los campos del RecordSet
    rs.Close
    dbConnection.Close ' Cierra la conexión a la base de datos
    Set rs = Nothing
    Set dbConnection = Nothing
    On Error GoTo 0
    Exit Function

InvalidInput:
    MsgBox "The source file or source range is invalid!", vbExclamation, "Get data from closed workbook"
    Set rs = Nothing
    Set dbConnection = Nothing

End Function

Sub Test()
    Dim Col As Collection
    Dim lgHoja As Long
    Dim strRuta_y_NombreArchivo As String
    Call fAbrirArchivo(strRuta_y_NombreArchivo)
    
    Set Col = GetSheetsNames(strRuta_y_NombreArchivo)
    For lgHoja = 1 To Col.Count
        MsgBox Col(lgHoja)
    Next lgHoja
End Sub


Sub TestReadDataFromWorkbook()
' Lee datos de un Libro cerrado
    Dim strRuta_y_NombreArchivo As String
    Call fAbrirArchivo(strRuta_y_NombreArchivo)
    
    Dim matrizTemporal As Variant, lgFila As Long, lgColumnaAs Long
    matrizTemporal = ReadDataFromWorkbook(strRuta_y_NombreArchivo, "A1:B21")
    ' Sin transposición de datos
'    For lgFila = LBound(matrizTemporal, 2) To UBound(matrizTemporal, 2)
'        For lgColumna = LBound(matrizTemporal, 1) To UBound(matrizTemporal, 1)
'            ActiveCell.Offset(lgFila, lgColumna).Formula = matrizTemporal(lgColumna, lgFila)
'        Next lgColumna
'    Next lgFila
    ' Con transposición de datos
    matrizTemporal = Application.WorksheetFunction.Transpose(matrizTemporal)
    For lgFila = LBound(matrizTemporal, 1) ToUBound(matrizTemporal, 1)
        For lgColumna = LBound(matrizTemporal, 2) ToUBound(matrizTemporal, 2)
            ActiveCell.Offset(lgFila - 1, lgColumna - 1).Formula = matrizTemporal(lgFila, lgColumna)
        Next lgColumna
    Next lgFila

End Sub