Проход по определенным подпапкам с использованием VBA

Question

Как я могу изменить код так, чтобы запрашивалась папка (где находится файл) и подпапки?На данный момент считывается только папка, в которой находится файл.Я хотел бы активировать эту функцию (например, AllSubfolders) с True или False.И, кроме того, способ запрашивать определенные подпапки, указав разные пути (для этого я бы установил для функции AllSubfolders значение false).

К сожалению, после нескольких попыток я не добился этого успеха.Мои знания VBA не очень хорошие.

Я пытался реализовать следующий код с моим:

Dim FileSystem As Object
Dim HostFolder As String

HostFolder = "C:\Users\admin\Desktop\Dokumente\"

Set FileSystem = CreateObject("Scripting.FileSystemObject")
DoFolder FileSystem.GetFolder(HostFolder)

Sub DoFolder(Folder)
    Dim SubFolder
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
    Next
    Dim File
    For Each File In Folder.Files
        ' Operate on each file
    Next
End Sub

, но безуспешно.С помощью следующего кода я копирую данные из нескольких файлов в папку активной рабочей книги.Я хочу установить True или False для поиска во вложенных папках и указать конкретные пути для копирования данных.

Sub Copy_Data_from_Files_in_Folder()

ActiveSheet.Range("A4:I1000").ClearContents 'Vorgegebenen Tabelleninhalt vor dem Kopieren der Daten löschen

Dim StatusCalc

'Makrobremsen lösen - Am Beginn eines Makros
With Application
    .EnableEvents = False
    StatusCalc = .Application.Calculation 'Aktuellen Berechnungsmodus merken
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

'Const sXlsPath = "C:\Users\admin\Desktop\Dokumente\" 'Pfad zu bestimmtem Ordner

'oder wenn sich die Dateien im selben Ordner befinden

sXlsPath = ThisWorkbook.Path 'Datei im gleichen Ordner wie Auswertungsdateien

Const iStartZeile = 4 'Angeben, ab welcher Zeile eingefügt werden soll
Const iStartSpalte = 1 'Angeben, ab welcher Spalte eingefügt werden soll
Const Zellen = "D3,K3,K7,H34,R3,D5,K5,R5,A29" 'Angeben, welche Zellen kopiert werden sollen

Dim oFso As Object, oFile As Object, oWkb1 As Workbook, oWks0 As Worksheet, oWks1 As Worksheet
Dim aCells As Variant, iNextLine As Long, i As Integer

Set oWks0 = ThisWorkbook.ActiveSheet

aCells = Split(Zellen, ","):  iNextLine = iStartZeile

Set oFso = CreateObject("Scripting.FilesystemObject")

For Each oFile In oFso.GetFolder(sXlsPath).Files
    If LCase(oFso.GetExtensionName(oFile.Name)) = "xlsx" Then 'Hier den Dateityp anpassen
        If ThisWorkbook.Path <> oFile.Name Then
            Set oWkb1 = Workbooks.Open(oFile.Path)
            Set oWks1 = oWkb1.Sheets(1)
            For i = 0 To UBound(aCells)
                oWks0.Cells(iNextLine, iStartSpalte).Offset(0, i) = oWks1.Range(Trim(aCells(i))).Value
            Next
            oWkb1.Close False
            iNextLine = iNextLine + 1
        End If
    End If
Next

Beenden: 'Sprungadresse zum Beenden diese Makros
'Makrobremsen zurücksetzen - vor dem Beenden eines Makros
  With Application
    .EnableEvents = True
    .Calculation = StatusCalc
    .ScreenUpdating = True
  End With

End Sub