Abrir excel de subcarpetas

Option Explicit

Public Sub AbrirLibros()

    Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object

    Dim Fichero As Object, tmpFichero As Object

    Dim strRutaInicial As String


    strRutaInicial = "D:\Check_List_Hold_Point"


    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fCarpeta = fso.GetFolder(strRutaInicial)


    For Each tmpFichero In fCarpeta.Files

    If LCase(Mid(tmpFichero.Name, InStr(tmpFichero.Name, ".") + 1)) = "xlsx" Then
        Workbooks.Open tmpFichero.Path
        ActiveWorkbook.Close savechanges:=False
    End If

    Next tmpFichero


    Recursivo strRutaInicial

End Sub


Private Sub Recursivo(ByVal RutaInicial As String)

    Dim fso As Object, fCarpeta As Object, tmpCarpeta As Object

    Dim Fichero As Object, tmpFichero As Object


    Set fso = CreateObject("Scripting.FileSystemObject")

    Set fCarpeta = fso.GetFolder(RutaInicial)


    For Each tmpCarpeta In fCarpeta.SubFolders

        For Each tmpFichero In tmpCarpeta.Files

            If LCase(Mid(tmpFichero.Name, InStr(tmpFichero.Name, ".") + 1)) = "xlsx" Then
                Workbooks.Open tmpFichero.Path
                ActiveWorkbook.Close savechanges:=False
            End If

        Next

        Recursivo tmpCarpeta.Path

    Next tmpCarpeta

End Sub