Unterordner mit einbeziehen

Sub BlätterLöschen()
'Dateien öffnen
Dim wks As Worksheet
Dim fs As FileSearch
Dim lRow As Long
Dim iCounter As Integer
'Application.ScreenUpdating= false
Application.DisplayAlerts = False
Set fs = Application.FileSearch
lRow = 3
'lRow = InputBox("Zeilen Nr. angeben")
With fs
.Filename = "*.xls"
.LookIn = Range("D1").Value
.Execute
For iCounter = 1 To .FoundFiles.Count
'Cells(lRow, 1).Value = .FoundFiles(iCounter)
If VBA.FileDateTime(.FoundFiles(iCounter)) < Now - 14 Then
lRow = lRow
Workbooks.Open .FoundFiles(iCounter)
'unbeschriebene Beschlaglisten löschen
For Each wks In ActiveWorkbook.Worksheets
With wks
Select Case .Name
Case "Holzliste", "Zeiten", "Laufkarte"
'do nothing
Case "BL Container"
If Application.WorksheetFunction.CountA(.Range("A7:A32")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Conside"
If Application.WorksheetFunction.CountA(.Range("A7:A15"), .Range("A38"), .Range("A40:A60")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Depona"
If Application.WorksheetFunction.CountA(.Range("A7:A15"), .Range("A40:A60")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL K4"
If Application.WorksheetFunction.CountA(.Range("A7:A17"), .Range("A21:A31"), .Range("A38:A40"), .Range("A46:A62")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL Kabinentrennwand"
If Application.WorksheetFunction.CountA(.Range("A7:A18"), .Range("A21:A26")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case "BL ComWagen"
If Application.WorksheetFunction.CountA(.Range("A8:A31"), .Range("A39:A62")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
Case Else
If Application.WorksheetFunction.CountA(.Range("A7:A31"), .Range("A39:A64")) < 1 Then
Application.DisplayAlerts = False
.Delete
Application.DisplayAlerts = True
End If
End Select
End With
Next wks
ActiveWorkbook.Close savechanges:=True
'Application.Wait Now + 5 / 86400
End If
Next iCounter
End With
'Application.ScreenUpdating=True
Application.DisplayAlerts = True
End Sub