Sub ChangeNoms()
Dim Réponse As Byte, Préfixe As String, fd As FileDialog, vrtSelectedItem As Variant, Temp
Dim ATraiter As String, Validé As Byte, Compteur As Integer
Réponse = MsgBox("Ne garder que le N° ?", vbYesNo + vbInformation, "Ancien nom de fichier")
Recommence:
Préfixe = InputBox("Préfixe à ajouter ?", "Préfixe")
If Préfixe = "" Then Exit Sub
If Len(Préfixe) <> Len(Validation(Préfixe)) Then
Validé = MsgBox("Le préfixe n'est pas valide, acceptez-vous " & Validation(Préfixe) & " ?", vbYesNo + vbCritical, "ATTTENTION !")
If Validé = vbNo Then GoTo Recommence Else Préfixe = Validation(Préfixe)
End If
Set fd = Application.FileDialog(msoFileDialogFilePicker)
On Error GoTo GestErreur
With fd
.AllowMultiSelect = True
If .Show = -1 Then
For Each vrtSelectedItem In .SelectedItems
If Réponse = vbNo Then
Temp = Split(vrtSelectedItem, "\")
Temp(UBound(Temp)) = Trim(Préfixe) & " " & Temp(UBound(Temp))
Name vrtSelectedItem As Join(Temp, "\")
Else
Temp = Split(vrtSelectedItem, "\")
ATraiter = Temp(UBound(Temp))
If Left(Nettoyage(ATraiter), 1) = "." Then
Temp(UBound(Temp)) = Trim(Préfixe) & " " & Format(Compteur, "000") & Nettoyage(ATraiter)
Compteur = Compteur + 1
Else
Temp(UBound(Temp)) = Trim(Préfixe) & " " & Nettoyage(ATraiter)
End If
Name vrtSelectedItem As Join(Temp, "\")
End If
Next vrtSelectedItem
Else
End If
End With
Set fd = Nothing
Exit Sub
GestErreur:
MsgBox "Traitement interrompu !", vbCritical + vbOKOnly, "Nom de fichier en double !"
End Sub
Function Nettoyage(Texte As String) As String
With CreateObject("vbscript.regexp")
.Global = False
.Pattern = "[0-9]*.[a-zA-Z]{3,4}$"
Nettoyage = .Execute(Texte)(0)
End With
End Function
Function Validation(ATester As String) As String
Dim Match, Matches
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "[^\[\]^<>\*\?""\|:/\\']"
Set Matches = .Execute(ATester)
For Each Match In Matches
Validation = Validation & Match
Next Match
End With
End Function