Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen Teil 2

Sub ImportiereCSVDateien()
    Dim ws As Worksheet, header As Boolean, startRange As Range, curRange As Range, counter As Integer, fso As Object, f As Object
    Const CSVPFAD = "E:\csv-dateien"  
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Set ws = Worksheets(1)
    ws.Range("A:ZZ").Clear  
    Set startRange = ws.Range("A2")  
    Set curRange = startRange
    Application.DisplayAlerts = False

    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(Right(f.Name, 3)) = "csv" Then  
            importCSV f.Path, ";", curRange, True  
            curRange.Offset(-1, 0).Value = f.Name
            curRange.Offset(-1, 0).Font.Bold = True
            Set curRange = curRange.End(xlToRight).Offset(0, 1)
        End If
        
    Next
    Application.DisplayAlerts = True
    Set fso = Nothing
End Sub

Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
    Dim fso As Object, regex As Object, patNumber As String, arrLines As Variant, rngCurrent As Range, intStart As Integer, cols As Variant, c As Integer, wert As String, matches As Object, i As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set regex = CreateObject("vbscript.regexp")  
    patNumber = "^([\d\.,\+\-]+)$"  
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
    Set rngCurrent = targetRange
    If importHeader Then
        intStart = 0
    Else
        intStart = 1
    End If
    For i = intStart To UBound(arrLines)
        If arrLines(i) <> "" Then  
            cols = Split(arrLines(i), delim, -1, vbTextCompare)
            For c = 0 To UBound(cols)
                rngCurrent.Offset(0, c).ClearFormats
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))  
                ' check for Numberformat  
                regex.Pattern = patNumber
                Set matches = regex.Execute(wert)
                If matches.Count > 0 Then
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)  
                End If
                ' set value in cell  
                rngCurrent.Offset(0, c).Value = wert
            Next
            Set rngCurrent = rngCurrent.Offset(1, 0)
        End If
    Next
    Set fso = Nothing
    Set regex = Nothing
End Function

Function importCSV(strPath, delim, ByVal targetRange As Range, ByVal importHeader As Boolean)
    Dim fso As Object, regex As Object, patNumber As String, arrLines As Variant, rngCurrent As Range, intStart As Integer, cols As Variant, c As Integer, wert As String, matches As Object, i As Integer
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set regex = CreateObject("vbscript.regexp")  
    patNumber = "^([\d\.,\+\-]+)$"  
    arrLines = Split(fso.OpenTextFile(strPath, 1).ReadAll(), vbNewLine, -1, vbTextCompare)
    Set rngCurrent = targetRange
    If importHeader Then
        intStart = 2
    Else
        intStart = 3
    End If
    For i = intStart To UBound(arrLines)
        If arrLines(i) <> "" Then  
            cols = Split(arrLines(i), delim, -1, vbTextCompare)
            For c = 0 To UBound(cols)
                rngCurrent.Offset(0, c).ClearFormats
                wert = Trim(Replace(cols(c), """", "", 1, -1, vbTextCompare))  
                ' check for Numberformat  
                regex.Pattern = patNumber
                Set matches = regex.Execute(wert)
                If matches.Count > 0 Then
                    wert = Replace(matches(0).Submatches(0), ",", ".", 1, -1, vbTextCompare)  
                End If
                ' set value in cell  
                rngCurrent.Offset(0, c).Value = wert
            Next
            Set rngCurrent = rngCurrent.Offset(1, 0)
        End If
    Next
    Set fso = Nothing
    Set regex = Nothing
End Function