Sub Recherche()
Dim dat As Variant, lig&, chemin$, fichier$
Do
dat = Application.InputBox("Date recherchée :")
If dat = False Then Exit Sub
Loop While Not IsDate(dat)
dat = DateValue(dat)
lig = 2
Rows(lig & ":" & Rows.Count).Delete 'RAZ
Cells(lig, 1) = "Liens des fichiers pour la date du " & dat
Cells(lig, 1).Font.Bold = True
Rows(1).RowHeight = 24
Do 'boucle pour traiter successivement plusieurs dossiers
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choix du dossier"
If .Show = False Then Exit Sub 'Annuler
chemin = .SelectedItems(1) & "\"
End With
fichier = Dir(chemin & "*.txt") '1er fichier texte du dossier
While fichier <> ""
If DateValue(FileDateTime(chemin & fichier)) = dat Then
lig = lig + 1
ActiveSheet.Hyperlinks.Add Cells(lig, 1), chemin & fichier 'lien hypertexte
End If
fichier = Dir 'fichier suivant
Wend
Columns(1).AutoFit 'ajustement largeur
If MsgBox("Autre dossier ?", vbYesNo + vbQuestion) = vbNo Then Exit Sub
Loop
End Sub