三月に一回くらい同じようなロジックを公私共に書いてる気がするので、ここに記す。

 Option Explicit
 ' ここを実行する
 Sub StartProgram()
     Dim filepath As Variant
 
     filepath = InputBox("フォルダパスを入力してください" & vbCrLf & "Ex. C:\Users\Somewhere", "ターゲットフォルダの指定")
 
     ' キャンセルすると "" が入るから、そんときはやめる
     If filepath = "" Then Exit Sub
 
     Dim fso As Object ' FileSystemObject
     Dim a
     Dim fld As Object ' Folder
     Set fso = CreateObject("Scripting.FileSystemObject")
 
     Set fld = fso.GetFolder(filepath)
 
     FolderProcess fld
 End Sub
 
 ' フォルダの中を漁ってXLSファイルを処理する
 Sub FolderProcess(ByVal fld As Object)
 
     ' サブフォルダを掘る
     Dim childFld As Object ' Folder
 
     For Each childFld In fld.SubFolders
         FolderProcess childFld
     Next
 
    ' ファイルを一個づつ見る
    Dim xlsfileRe As Object ' RegExp
    Dim childFile As Object ' File
    Dim mths As Object
    Set xlsfileRe = CreateObject("VBScript.RegExp")
    xlsfileRe.Pattern = ".xlsx?$" ' xlsかxlsxか
    xlsfileRe.IgnoreCase = True

    For Each childFile In fld.Files
        Set mths = xlsfileRe.Execute(childFile.Name)
        ' マッチがなければ違うファイル。
        If mths.Count > 0 Then FileProcess childFile
    Next
End Sub

' ファイル一個の処理
Sub FileProcess(ByVal f As File)
    Dim wb As Workbook
    Dim ws As Worksheet
    Set wb = Application.Workbooks.Open(f.Path)

    For Each ws In wb.Sheets
        SheetProcess ws
    Next

    ' なんか警告言うてくることがあるので、黙らせる
    ' とりあえずこれだけでなんとかなったけど、ならない場合はググってください。
    Application.DisplayAlerts = False
    wb.Save
    wb.Close

    ' 黙らせたやつを戻す
    Application.DisplayAlerts = True
End Sub

Sub SheetProcess(ByVal ws As Worksheet)
    ' ここでシートごとの処理

    ' 試しにA1セルにみたよと入れる。
    ws.Range("A1").Value = "みたよ"

End Sub