Sub Traitement(ByVal Repertoire As String)
Dim Fso As Object, SourceFolder As Object, SubFolder As Object, FileItem As Object
Dim Wbk As Workbook
On Error GoTo Traitement_Error
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set Fso = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = Fso.GetFolder(Repertoire)
'Boucle sur tous les fichiers du répertoire
For Each FileItem In SourceFolder.Files
If FileItem.Name Like "*##-##-####.xls*" Then
Set Wbk = Workbooks.Open(FileItem)
With Wbk.Worksheets(1)
.[D:D].ClearContents 'RAZ
.[D1] = "Date"
.[D:D].NumberFormat = "dd-mm-yyyy"
.Range("D2:D" & .Range("A" & .Rows.Count).End(xlUp).Row).FormulaR1C1 = _
"=DATEVALUE(MID(CELL(""filename"",RC),SEARCH("".xls"",CELL(""filename"",RC))-10,10))"
End With
Wbk.Close True
End If
Next FileItem
'--- Appel récursif pour lister les fichier dans les sous-répertoires ---.
For Each SubFolder In SourceFolder.subfolders
Traitement SubFolder.Path
Next SubFolder
Traitement_Error:
Application.DisplayAlerts = True
Set SourceFolder = Nothing
Set Fso = Nothing
End Sub
Sub Test()
Traitement "C:\Users\toto\Desktop\testons"
End Sub