Sub GetFileNames_V2()
Dim xDirect$, xFname$, InitialFoldr$, wb As Workbook
InitialFoldr$ = "C:\"
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = Application.DefaultFilePath & "\"
.Title = "Merci de choisir le dossier source, svp"
.InitialFileName = InitialFoldr$
.Show
If .SelectedItems.Count <> 0 Then
xDirect = .SelectedItems(1) & "\"
xFname = Dir(xDirect$, 7)
Do While xFname <> ""
DoEvents
Set wb = Workbooks.Open(Filename:=xDirect & xFname)
wb.BuiltinDocumentProperties("Title") = xFname
wb.Close SaveChanges:=True
DoEvents
xFname = Dir
Loop
End If
End With
MsgBox "Tâche terminée!"
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub