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
    MsgBox "Готово!"
End Sub

Private Sub GetSubFolders(sPath)
    Dim sPathSeparator As String, sObjName As String
    Set objFolder = objFSO.GetFolder(sPath)
    For Each objFile In objFolder.Files
        If Replace(objFile.Name, objFSO.GetBaseName(objFile), "") Like ".xls" Then
            Workbooks.Open sPath & objFile.Name
            ActiveWorkbook.SaveAs Filename:= _
                sPath & objFile.Name & "x" _
                , FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close True
            Kill (sPath & objFile.Name)
        End If
    Next
    For Each objFolder In objFolder.SubFolders
        GetSubFolders objFolder.Path & Application.PathSeparator
    Next
End Sub