Problème macro traitement CSV

Bonjour,

J'ai réalisé une petite macro me permettant de lire une 30aine de fichier csv afin d'extraire les données dans un fichier excel (1 csv = 1 page).

J'ai deux problème avec mon code, le premier survient lors de la lecture des fichiers. A un moment j'obtiens l'erreur 7 "Mémoire insuffisante"', cela arrive vers le 27ème fichier, peut importe l'ordre dans lequel ils sont rangés le plus petit fait 1Ko et le plus grand 37ko, donc ça me parait assez improbable vu la petite quantité de donnée.

Le second problème est que j'aimerais supprimer chaque fichier une fois qu'il est traité, mais la commande Kill path ne me donne que l'erreur 13 "Incompatibilité de type". J'ai vérifié x fois le chemin et l'ait même rentré à la main mais sans succès ni indice sur le problème.

Voici mon code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
 
Sub ImportCSV()
'
' ImportCSV Macro
'
' Touche de raccourci du clavier: Ctrl+Shift+J
'
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
 
    Sheets.Add.Name = "New"
 
    For Each xWs In Application.ActiveWorkbook.Worksheets
        If xWs.Name <> "New" Then
            xWs.Delete
        End If
    Next
 
    Dim filepath As String, file As String, fileName As Variant, folder As String
    Dim first As Boolean
 
    folder = ActiveWorkbook.Path + "\"
    fileName = Dir(folder + "*Configuration*" + "*.csv*")
 
    While fileName <> ""
 
        filepath = folder + fileName
        file = Mid(fileName, 17)
        file = Left(file, Len(file) - 4)
 
        If Len(file) >= 31 Then
            file = Left(file, 31)
        End If
 
        If first = False Then
            Sheets(ActiveSheet.Name).Name = file
            first = True
 
        Else
            Sheets.Add.Name = file
            ' MsgBox file
            Sheets(file).Activate
        End If
 
        With Sheets(file).QueryTables _
            .Add(Connection:="TEXT;" & filepath, Destination:=ActiveCell)
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = xlMSDOS
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
 
 
        Debug.Print filepath
        If Len(Dir$(filepath)) > 0 Then
            'First remove readonly attribute, if set
            SetAttr filepath, vbNormal
            Kill (filepath)
        End If
 
        Set fileName = Nothing
        fileName = Dir
    Wend
 
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub