1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
| Private Function RenommerFichier(sDossier As String, sNomfichier As String) As String
Dim sNouveauNom As String
Dim sPre As String, sExt As String
Dim i As Long
Dim FSO As Object
Set FSO = CreateObject("Scripting.FileSystemObject" )
If FSO.FileExists(sDossier & "\" & sNomfichier) Then
sNouveauNom = sNomfichier
sPre = FSO.GetBaseName(sNomfichier)
sExt = FSO.GetExtensionName(sNomfichier)
i = 0
While FSO.FileExists(sDossier & "\" & sNouveauNom)
i = i + 1
sNouveauNom = sPre & Chr(40) & Format(i, "000" ) & Chr(41) & Chr(46) & sExt
Wend
sNomfichier = sNouveauNom
End If
Set FSO = Nothing
RenommerFichier = sDossier & "\" & sNomfichier
End Function |
Partager