Sub ПримерИспользованияФункции_DATfolder2Array()
    Папка = "D:\0\AreaData_1\"    ' папка, в которой будет производиться поиск файлов DAT для обработки
    Dim ErrorsArray    ' пустой массив для ошибок

    ' считываем данные из все файлов .DAT в папке в двумерный массив
    DataArr = DATfolder2Array(Папка, 8, "1,2,4,5", ErrorsArray)
 
    ' результаты выводим на листы "errors" и "result" (они должны существовать)
    Array2worksheet Worksheets("errors"), ErrorsArray, _
                    Array("Имя файла", "Номер строки", "Данные из строки")
    Array2worksheet Worksheets("result"), DataArr, _
                    Array("0", "Label", "Area", "Feret", "FeretX", "FeretY", "FeretAngle", "MinFeret")
End Sub

Function DATfolder2Array(ByVal FolderPath$, ByVal ColumnsCount As Long, _
                         ByVal TextColumns$, ByRef ErrorsArr) As Variant
    ' получает путь FolderPath$ к папке с DAT-файлами
    ' считывает из файлов все строки, в которых число записей в строке равно ColumnsCount
    ' остальные (неподходящие) строки отправляет в массив ErrorsArr
    ' (столбцы ErrorsArr: 1-имя файла, 2 - номер строки, 3 - данные)
    ' в переменной TextColumns$ через запятую перечислены номера ТЕКСТОВЫХ столбцов
    ' Возвращает двумерный массив размером N*ColumnsCount

    ReDim ErrorsArr(1 To 1000, 1 To ColumnsCount + 2)
    On Error Resume Next
 
    Dim coll As New Collection, filename
    filename = Dir(FolderPath$ & "*.csv")
    While filename <> ""
        coll.Add filename    ' считываем в колекцию coll нужные имена файлов
        filename = Dir
    Wend
 
    Dim newtxt As String, ro As String, errIndex As Long
    For Each filename In coll
        Application.StatusBar = "Обрабатывается файл: " & filename
        newtxt = ReadTXTfile(FolderPath$ & filename)
        tempArr = "": tempArr = Split(newtxt, vbNewLine)
        For i = LBound(tempArr) To UBound(tempArr)
            ro = tempArr(i): ro = Replace(ro, vbTab, ",")
            If UBound(Split(ro, ",")) <> ColumnsCount - 1 And Len(Trim(ro)) > 0 Then
                tempArr(i) = "": errIndex = errIndex + 1
                ErrorsArr(errIndex, 1) = filename
                ErrorsArr(errIndex, 2) = "Строка " & i + 1
                ErrorsArr(errIndex, 3) = ro
            End If
        Next i
        newtxt = Join(tempArr, vbNewLine)
        txt = txt & newtxt & vbNewLine: DoEvents
    Next
    While InStr(1, txt, vbNewLine & vbNewLine) > 0
        txt = Replace(txt, vbNewLine & vbNewLine, vbNewLine)
    Wend
 
    txt = Replace(txt, vbTab, ","): tempArr = Split(txt, vbNewLine)
    ReDim newArr(1 To UBound(tempArr), 1 To ColumnsCount)
 
    For i = LBound(tempArr) To UBound(tempArr)
        roArr = "": roArr = Split(tempArr(i), ",")
        For j = 1 To ColumnsCount
            newArr(i + 1, j) = roArr(j - 1)
            If "," & TextColumns$ & "," Like "*," & j & ",*" Then
                newArr(i + 1, j) = "'" & newArr(i + 1, j)
            End If
        Next j
    Next i
    DATfolder2Array = newArr
    Application.StatusBar = False
End Function