Sub Перебор_файов_в_папке()
    Dim sFolder As String, sFiles As String, li As Long
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems( 1 )
    End With
    Application.ScreenUpdating = False
    sFiles = Dir(sFolder & Application.PathSeparator & "*.xlsx")'можно искать по части имени файла - "*Книга*.xlsx" - будет перебор всех файлов в выбранной папке, содержащих в имени "Книга"
    Do While sFiles <> ""
        Workbooks.Open sFiles
        'необходимые действия, в том числе поиск нужного текста.
        ActiveWorkbook.Close True
        sFiles = Dir
    Loop
    Application.ScreenUpdating = True
End Sub

Sub Просмотр_подпапок()
    Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems( 1 )
    End With
    sFolder = sFolder & IIf(Right(sPath,  1 ) = Application.PathSeparator, "", Application.PathSeparator)
    Call GetSubFolders(sFolder)
End Sub
Private Sub GetSubFolders(sPath)
    Dim sObjName As String
    sObjName = Dir(sPath, vbDirectory)
    Do While sObjName <> ""
        If sObjName <> "." And sObjName <> ".." Then
            'Если это папка, то вызываем функцию саму из себя - т.е. рекурсия
            If vbDirectory = GetAttr(sPath & sObjName) And vbDirectory Then
                GetSubFolders (sPath & sObjName & "\")
            Else
                'Открываем и производим нужные действия, если это файл
                Workbooks.Open sPath & sObjName
            End If
        End If
        sObjName = Dir
    Loop: Exit Sub
    MsgBox "Указанная папка не существует", vbInformation, ""
End Sub