Sub Prefixer()
' les fichiers préfixés débutent par NNNN_
Dim FicSuiv As String, Prefix As String, oldPath, newDir
Dim Liste, Nbr, Temp, NumFichier, Tempo
'initialisation
oldPath = CurDir
newDir = Range("B2")
Tempo = Range("B3")
If Right(newDir, 1) <> "\" Then newDir = newDir & "\"
'Création du fichier .bat
ChDir newDir
If Dir(newDir & "lister.bat") <> "" Then Kill newDir & "lister.bat"
If Dir(newDir & "listage.txt") <> "" Then Kill newDir & "listage.txt"
NumFichier = FreeFile
Open newDir & "Lister.bat" For Append As #NumFichier
Print #NumFichier, "Dir " & newDir & "*.* /A-D-H-S-L-R /TC /B /OD >" & newDir & "Listage.txt"
Print #NumFichier, ""
'une p'tite tempo
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + 2)
Close #NumFichier
'recherche les fichiers du dossier via un fichier.bat
Temp = Shell(newDir & "Lister.bat", vbHide)
'temporisation
Application.Wait TimeSerial(Hour(Now()), Minute(Now()), Second(Now()) + Tempo)
'Chercher le max des fichiers déjà renommés
NumFichier = FreeFile
Open newDir & "Listage.txt" For Input As #NumFichier
Do While Not EOF(NumFichier)
Line Input #NumFichier, FicSuiv
If IsNumeric(Mid(FicSuiv, 1, 4)) And Mid(FicSuiv, 5, 1) = "_" Then
'le fichier est déjà renommé
If Nbr < CInt(Mid(FicSuiv, 1, 4)) Then Nbr = CInt(Mid(FicSuiv, 1, 4))
End If
Loop
Close #NumFichier
'Renommer les fichiers
NumFichier = FreeFile
Open newDir & "Listage.txt" For Input As #NumFichier
Do While Not EOF(NumFichier)
Line Input #NumFichier, FicSuiv
If LCase(FicSuiv) <> LCase(ThisWorkbook.Name) Then
If LCase(FicSuiv) <> "lister.bat" Then
If LCase(FicSuiv) <> "listage.txt" Then
If Not (IsNumeric(Mid(FicSuiv, 1, 4)) And Mid(FicSuiv, 5, 1) = "_") Then
'le fichier n'est pas encore renommé
Nbr = Nbr + 1
Name newDir & FicSuiv As newDir & Format(Nbr, "0000_") & FicSuiv
End If
End If
End If
End If
Loop
Close #NumFichier
ChDir oldPath
MsgBox "C'est fini !"
ThisWorkbook.Close SaveChanges:=False
End Sub