Option Explicit
Dim I As Long
Sub Test()
Dim Chemin As String, Dossier As Object, SousDossier As Object, Fichier As Object
Chemin = "C:\Temp\"
I = 1
Application.ScreenUpdating = False
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each Fichier In Dossier.Files
If Left(Fichier.Name, 2) = "XM" Then
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
End If
Next
ListeFichier (Chemin)
Application.ScreenUpdating = True
End Sub
Function ListeFichier(Chemin As String) As String
Dim Dossier As Object, SousDossier As Object, Fichier As Object
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)
For Each SousDossier In Dossier.SubFolders
ListeFichier (Chemin & SousDossier.Name & "\")
For Each Fichier In SousDossier.Files
If Left(Fichier.Name, 2) = "XM" Then
Cells(I, 1) = Fichier.Name
Cells(I, 2) = Fichier.Path
If Right(Fichier.Name, 4) = ".txt" Then Cells(I, 3) = NbreLigne(Fichier.Path)
I = I + 1
End If
Next
Next
End Function
Function NbreLigne(Chemin As String) As Integer
Dim MyString As String
Open Chemin For Input As #1
Do While Not EOF(1)
Input #1, MyString
NbreLigne = NbreLigne + 1
Loop
Close #1
End Function