Excel vba reading large amount of files faster

Question

I have vritten a code that finds all files starting with specific name and reads data from them, there is usually 1k files or more in the folder, i wrote a little benchmark and realize that my code reads aprox 1 file per second and that is a lot of time. I am prety new to vba, and i was wondering if i took a wrong aproach to this ? Function Code:

Function ReadDataFromWorksheet()
Dim XL As Excel.Application
Dim WBK As Excel.Workbook
Dim i As Integer

i = 1

Set XL = CreateObject("Excel.Application")

Do While i < (ArraySize + 1)
    Set WBK = XL.Workbooks.Open("PATH TO FILE")
    Array(i).Data1 = WBK.ActiveSheet.Range("F6").Value
    WBK.Close SaveChanges:=False
    i = i + 1
Loop

Set XL = Nothing
End Function

Sorry for my bad spelling!... and thank you in advance for help!

Answer 1

Here is how you should use the Dir :

Function ReadDataFromWorksheet() As Variant

With Application
    .EnableEvents = False 'stop executing this code until we are done
    .DisplayAlerts = False
    .ScreenUpdating = False
    '.Calculation = xlCalculationManual
End With

Dim XL As Excel.Application
Dim WBK As Excel.Workbook
Dim FileName As String, _
    FolderPath As String, _
    Results()
ReDim Results(0)

On Error Resume Next
Set XL = GetObject(, "Excel.Application")
If Err.Number > 0 Then Set XL = CreateObject("Excel.Application")
On Error GoTo 0

FolderPath = "C:/test/"
FileName = Dir(FolderPath & "*.xlsx")

Do While FileName <> ""
    Set WBK = XL.Workbooks.Open(FolderPath & FileName)
    Results(UBound(Results)) = WBK.ActiveSheet.Range("F6").Value
    WBK.Close SaveChanges:=False
    ReDim Preserve Results(UBound(Results) + 1)
    FileName = Dir
Loop
ReDim Preserve Results(UBound(Results) - 1)

Set WBK = Nothing
Set XL = Nothing

With Application
    .EnableEvents = True
    .DisplayAlerts = True
    .ScreenUpdating = True
    '.Calculation = xlCalculationAutomatic
End With

ReadDataFromWorksheet = Results
End Function