Sub Renommer2()
Dim chemin$, fich$, ext$, x%, nom1$, nom$, texte$
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Choisissez un dossier"
.AllowMultiSelect = False
If .Show = False Then Exit Sub
chemin = .SelectedItems(1) & "\"
End With
fich = Dir(chemin & "*.*")
While fich <> ""
ext = Mid(fich, InStrRev(fich, "."), 9)
x = FreeFile
Open chemin & fich For Input As #x 'ouverture en lecture séquentielle
nom1 = "": nom = ""
Do While Not EOF(x)
Line Input #x, texte
If texte Like ":25:*" Then '1er critère
nom1 = Mid(texte, 5, 9 ^ 9)
ElseIf nom1 <> "" And (texte Like ":28:*" Or texte Like ":28C:*") Then '2ème critère
nom = nom1 & "-" & Mid(texte, InStr(2, texte, ":") + 1, 9 ^ 9) & ext
nom = Replace(nom, "/", "-")
Exit Do
End If
Loop
Close #x
On Error Resume Next
If nom <> "" Then Name chemin & fich As chemin & nom 'renomme le fichier
On Error GoTo 0
fich = Dir()
Wend
End Sub