' Purpose   : http://www.excel-vba.ru/chto-umeet-excel/prosmotret-vse-fajly-v-papke/
'---------------------------------------------------------------------------------------
Option Explicit
 
Dim objFSO As Object, objFolder As Object, objFile As Object
 
Sub Get_All_File_from_SubFolders()
    Dim sFolder As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = False Then Exit Sub
        sFolder = .SelectedItems(1)
    End With
    sFolder = sFolder & IIf(Right(sFolder, 1) = Application.PathSeparator, "", Application.PathSeparator)
    Application.ScreenUpdating = False
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    GetSubFolders sFolder
    Set objFolder = Nothing
    Set objFSO = Nothing
    Application.ScreenUpdating = True
End Sub
Private Sub GetSubFolders(sPath)
    Dim sPathSeparator As String, sObjName As String
    Dim wb As Workbook
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then
            'открываем книгу
            Set wb = Application.Workbooks.Open(sPath & objFile.Name)
            'действия с файлом
            'Запишем на первый лист книги в ячейку А1 - текущая дата
            wb.Sheets(1).Range("A1").Value = Format(Now, "dd.mm.yyyy")
            'Меняем цвет ячеек A4:D8
            Range("A4:D8").Interior.Color = RGB(100, 150, 250)
            'Ставим пароль на текущий лист каждого файла 123
            wb.Sheets(1).Protect "123"
            wb.Close True
        End If
    Next
    For Each objFolder In objFolder.SubFolders
        GetSubFolders objFolder.Path & Application.PathSeparator
    Next
End Sub

Private Sub GetSubFolders2(sPath)
    Dim sPathSeparator As String, sObjName As String
    Dim wb As Workbook
    Dim lCounter As Long: lCounter = 0
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls*" Then
             'открываем книгу
            Set wb = Application.Workbooks.Open(sPath & objFile.Name)
            'действия с файлом
            With ThisWorkbook.Worksheets("Лист1").Range("A1")
        .Offset(lCounter).Value = wb.Sheets(1).Range("A1").Value
        .Offset(lCounter, 1).Value = objFile.Name
        lCounter = lCounter + 1
    End With
            wb.Close True
        End If
    Next
    For Each objFolder In objFolder.SubFolders
        GetSubFolders2 objFolder.Path & Application.PathSeparator
    Next
End Sub