Prüfen, ob Unterordner existieren

    Dim oWkb1 As Workbook, oWks1 As Worksheet, oWks0 As Worksheet
Dim aCells As Variant, iNextLine As Long, i As Long
Dim StatusCalc As XlCalculation
Dim avntFolders() As Variant, avntTempFolder() As Variant
Dim strFile As String, sXlsPath As String, strSelectedFolder() As String
Dim ialngFolders As Long, ialngIndex As Long, lngCount As Long
sXlsPath = ThisWorkbook.Path & "\" 'Datei im gleichen Ordner wie Auswertungsdateien
'Abfrage aller Unterordner (Die Abfragetabelle befindet sich dabei im Hauptordner)
If MsgBox("Alle Unterordner durchsuchen?", vbQuestion Or vbYesNo, "Abfrage") = vbYes Then
avntFolders = GetFolders(sXlsPath) 'Hauptordner und alle Unterordner
ReDim Preserve avntFolders(LBound(avntFolders) To UBound(avntFolders) + 1) 'Mit + 1 die  _
Unterordner der Unterordner auch mitabfragen
'Folgende Zeile mit ' ausklammern, wenn Dateien des Hauptordners nicht berücksichtigt  _
werden sollen
'avntFolders(UBound(avntFolders)) = sXlsPath
Call QuickSort(LBound(avntFolders), UBound(avntFolders), avntFolders)
Else
'Abfrage ausgewählter Unterordner (Die Abfragetabelle befindet sich dabei im  _
Hauptordner)
If MsgBox("Nur bestimmte Unterordner durchsuchen?", vbQuestion Or vbYesNo, "Abfrage") =  _
vbYes Then
With UserForm1
.Path = sXlsPath
Call .Show
If .Cancel Then
Call Unload(Object:=UserForm1)
Exit Sub
Else
strSelectedFolder = .Folders
Call Unload(Object:=UserForm1)
End If
End With
For ialngIndex = LBound(strSelectedFolder) To UBound(strSelectedFolder)
avntTempFolder = GetFolders(strSelectedFolder(ialngIndex))
If SafeArrayGetDim(avntTempFolder)  0 Then
ReDim Preserve avntTempFolder(LBound(avntTempFolder) To UBound( _
avntTempFolder) + 1) 'Mit + 1 die Unterordner der Unterordner auch mitabfragen
Else
ReDim avntTempFolder(0)
End If
avntTempFolder(UBound(avntTempFolder)) = strSelectedFolder(ialngIndex)
ReDim Preserve avntFolders(LBound(avntTempFolder) To UBound(avntTempFolder) +  _
lngCount)
For ialngFolders = LBound(avntTempFolder) To UBound(avntTempFolder)
avntFolders(ialngFolders + lngCount) = avntTempFolder(ialngFolders)
Next
lngCount = lngCount + ialngFolders
Next
ReDim Preserve avntFolders(LBound(avntFolders) To UBound(avntFolders) + 1) 'Mit + 1  _
die Unterordner der Unterordner auch mitabfragen
'Folgende Zeile mit ' ausklammern, wenn Dateien des Hauptordners nicht berü _
cksichtigt werden sollen
'avntFolders(UBound(avntFolders)) = sXlsPath
Call QuickSort(LBound(avntFolders), UBound(avntFolders), avntFolders)
Else
'Wenn alles mit Nein beantwortet wurde, werden nur die Dateien im Hauptordner  _
abgefragt
avntFolders = Array(sXlsPath) 'Nur Hauptordner ohne Unterordner
End If
End If

Private Function GetFolders(ByVal pvstrPath As String) As Variant()
Dim avntFolders() As Variant
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
strPath = pvstrPath
Do
strFolder = Dir$(strPath & "*", vbDirectory)
Do Until strFolder = vbNullString
If strFolder  "." And strFolder  ".." Then
If GetAttr(strPath & strFolder) And vbDirectory Then
ReDim Preserve avntFolders(0 To ialngIndex1)
avntFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = avntFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = avntFolders
End Function
Private Sub QuickSort(ByVal pvlngLBound As Long, ByVal pvlngUbound As Long, ByRef prvntArray As  _
Variant)
Dim lngIndex1 As Long, lngIndex2 As Long
Dim vntTemp As Variant, vntBuffer As Variant
lngIndex1 = pvlngLBound
lngIndex2 = pvlngUbound
vntBuffer = prvntArray(Fix(pvlngLBound + pvlngUbound) / 2)
Do
Do While prvntArray(lngIndex1)  lngIndex2
If pvlngLBound