FreeFile Multiple CSVs Error 67 Too many files-CodePudding

Background
I need to open multiple csvs in multiple folders, and for this matter I use FreeFile as input: let's say there are over 1000 csvs (powerquery will not have use here, since I only need the last row of data of each csv and then analyze that). I have seen that expanding to 512 may temporarily fix it in a way, but I do not think that is the core cause, hence, not providing a long term solution.
Problem
Seems like even if I close the file, the memory is not properly cleared, hence I get an error 67 after some looping on files has been done.
Code
I created a function to retrieve the Last Line within my main sub code, I even attempted to loop until freefile is 1 again (I added some sleep as well), but no luck, at some point, grows at 2.

Function Return_VarInCSVLine(ByRef NumLineToReturnTo As Long, ByRef TxtFilePathCSV As String, Optional ByRef IsLastLine As Boolean) As Variant
If NumLineToReturnTo = 0 Then NumLineToReturnTo = 1
'NumLineToReturnTo has to be at least 1 even if LastLine is set to true so no error is arised from IIF
Dim NumFileInMemory As Long
Dim ArrVarTxtLines() As Variant
Dim CounterArrTxtLines As Long
Dim TxtInLine As String
    NumFileInMemory = FreeFile: CounterArrTxtLines = 1
    Open TxtFilePathCSV For Input As #NumFileInMemory: DoEvents
    Do While Not EOF(NumFileInMemory)
    Line Input #NumFileInMemory, TxtInLine
    ReDim Preserve ArrVarTxtLines(1 To CounterArrTxtLines)
    ArrVarTxtLines(CounterArrTxtLines) = TxtInLine
    CounterArrTxtLines = CounterArrTxtLines   1
    Loop
LoopUntilClosed:
    Close #NumFileInMemory: Sleep (10): DoEvents
    NumFileInMemory = FreeFile
    If NumFileInMemory > 1 Then GoTo LoopUntilClosed
    Return_VarInCSVLine = IIf(IsLastLine = True, ArrVarTxtLines(UBound(ArrVarTxtLines)), ArrVarTxtLines(NumLineToReturnTo))
End Function

Question
How can I avoid this error in this scenario? Or what are my alternatives? I used to do workbooks.Open but that is slower than just using FreeFile and then Open for input

CodePudding user response：

You could try to use the FileSystemObject on a Windows PC

Function fsoReadLine(fileName As String, lineNo As Long, Optional lastLine As Boolean) As String
    Dim fso As Object
    Dim textFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set textFile = fso.OpenTextFile(fileName, 1)
        
    Dim vDat As Variant
    ' Read the whole file and split it by lines
    vDat = Split(textFile.ReadAll, vbCrLf)
    
    Dim totalLines As Long
    totalLines = UBound(vDat)   1  ' zero based array!
    
    If lastLine Then
        fsoReadLine = vDat(totalLines - 1)
    Else
        If lineNo <= totalLines Then
            fsoReadLine = vDat(lineNo - 1)
        End If
    End If
    textFile.Close
    
End Function

And if you only need the last line you could shorten the code to

Function fsoLastLine(fileName As String) As String
    Dim fso As Object
    Dim textFile As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set textFile = fso.OpenTextFile(fileName, 1)
        
    Dim vDat As Variant
    ' Read the whole file and split it by lines
    vDat = Split(textFile.ReadAll, vbCrLf)
    
    fsoLastLine = vDat(UBound(vDat))
    textFile.Close
    
End Function