Excel - Daten aus ungeöffneten Excel-Dateien auslesen

Sub Schaltfläche1_Klicken()

Dim dat
Dim ordner
Dim datein
Dim fso
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Ein Array mit 500 Zeilen und 6 Spalten.  
'Dient zur späteren Aufnahme der Werte.  
Dim arr(500, 6)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXX  
Dim L As Long
Dim Z As Long
Dim WB
Dim dsplalert As Boolean
Dim cal
Dim scrup As Boolean
Dim ev As Boolean
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Zum Beschleunigen des Makros  
With Application
    dsplalert = .DisplayAlerts
    cal = .Calculation
    scrup = .ScreenUpdating
    ev = .EnableEvents
    .DisplayAlerts = False              'Excelinterne Meldungen aus  
    .Calculation = xlCalculationManual  'Automatische Berechnung aus  
    .ScreenUpdating = False             'Bildschirm aktualisierung aus  
    .EnableEvents = False               'Makrostarts aus  
End With

'XXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Überschriften ins Array schreiben  
arr(L, 0) = "Datum"  
arr(L, 1) = "Rechnungsnummer"  
arr(L, 2) = "Kundennummer"  
arr(L, 3) = "Kundenname"  
arr(L, 4) = "MwSt"  
arr(L, 5) = "Gesamtbetrag"  
L = L + 1
'XXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Dialog aufrufen  
'Die innere IF-Then Konstruktion fängt "Abbrechen" in dem Dialog ab.  
Set dat = Application.FileDialog(msoFileDialogFolderPicker)
With dat
   .Title = "Suchen..."  
   .InitialFileName = "C:\" 'oder was auch immer  
nochmal:
If .Show = -1 Then
    ordner = .SelectedItems(1)
Else:
    If MsgBox("Ordner auswählen vergessen." & vbCrLf & "Nochmal ?", vbYesNo) = vbYes Then  
    GoTo nochmal
    Else:
        GoTo raus
    End If
End If
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Zugriff aus Dateisystem  
Set fso = CreateObject("Scripting.filesystemobject")  
Set datein = fso.getfolder(ordner)
'XXXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Sucht jedes file in Ordner.  
'i istdie Variable  
For Each WB In datein.Files
    If WB.Name Like "*.xlsx" Or WB.Name Like "*.xls" Then 'selbserklärend  
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXX  
        Workbooks.Open WB        'selbserklärend  
                arr(L, 0) = Sheets(1).Cells(16, 6).Text
                arr(L, 1) = Sheets(1).Cells(17, 2).Text
                arr(L, 2) = Sheets(1).Cells(18, 1).Text
                arr(L, 3) = Sheets(1).Cells(9, 1).Text
                arr(L, 4) = Sheets(1).Cells(31, 4).Text
                arr(L, 5) = Sheets(1).Cells(33, 6).Text
                L = L + 1
                
        Workbooks(WB.Name).Close False
        'XXXXXXXXXXXXXXXXXXXXXXXXXXXX  
    End If
Next
Range("A:F") = arr 'Alle Werte auf einmal in die Tabelle übertragen  

raus:
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  
'Die Eingangs gemachten Einstellungen Rückgängig machen  
With Application
     .DisplayAlerts = dsplalert
     .Calculation = cal
     .ScreenUpdating = scrup
     .EnableEvents = ev
End With
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX  

End Sub