For i = 1 To .FoundFiles.Count ' Parcours de tous les dossiers
[COLOR=red]Set ficLire = fso.OpenTextFile(.foundfiles(i), 8,True) 'Il me semble que cette ligne manque ?[/COLOR]
LigneaEcrire = ""
[COLOR=red]NumLigne = 1[/COLOR]
Do Until ficLire.atendofstream
Lireligne = ficLire.readline
If [COLOR=red]NumLigne = 4[/COLOR] Then
LigneaEcrire = LigneaEcrire & Lireligne & ";"
End If
[COLOR=red]NumLigne = NumLigne +1[/COLOR]
Loop
Lignes(UBound(Lignes)) = LigneaEcrire
ReDim Preserve Lignes(1 To UBound(Lignes) + 1)
ficLire.Close
Next i