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 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Option Explicit
Dim MyRootFolder, n, Tot, Msg
MyRootFolder = Browse4Folder
Call Scan4File(MyRootFolder, Tot, n)
If n = 1 Then
Msg = "Script fini !" & vbcr & "Il y a " & n & " fichier parmis " & Tot & " qui a été renommé !"
ElseIf n > 1 Then
Msg = "Script fini !" & vbcr & "Il y a " & n & " fichiers parmis " & Tot & " qui ont été renommés !"
ElseIf n = 0 Then
Msg = "Aucun fichier parmis " & Tot & " n'a été renommé !"
End If
MsgBox Msg, vbInformation, "Opération fini !"
'**************************************************************************
Function Browse4Folder()
Dim objShell,objFolder,Message
Message = "Choisir un dossier en vue de renommer ses fichiers"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, Message, 1, 0)
If objFolder Is Nothing Then
Wscript.Quit
End If
Browse4Folder = objFolder.self.path
End Function
'****************************************************************************
Sub Scan4File(Folder, Tot, n)
Dim fso,objFolder,arrFiles,FileName, iCount
Dim SubFolder,aFile
Dim oShell,iRet
n = 0 : Tot = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(Folder)
Set arrFiles = objFolder.Files
If arrFiles.Count = 0 Then
If MsgBox("Le Dossier " & Folder & " ne contient pas de fichiers." & vbCrLf & _
"Voulez-vous traiter un autre dossier ?",vbYesNo,"Autre dossier à traiter ?") = vbYes Then
Set objFolder = fso.GetFolder(Browse4Folder)
Set arrFiles = objFolder.Files
On Error GoTo 0
Else
Exit Sub
End If
End If
iCount = 0
Set oShell = WScript.CreateObject("WScript.Shell")
For Each FileName in arrFiles
Set aFile = fso.GetFile(FileName)
iRet = InputBox ("Comment voulez-vous renommer le fichier ?", "Renommer fichiers",FileName)
If iRet <> "" Then
If UCase(iRet) <> UCase(FileName) Then
aFile.Move iRet
iCount = iCount + 1
oShell.Popup "Le fichier : " & vbcr & FileName & vbcr & vbcr & " est devenu : " & vbcr & iRet, 3, "Information", vbOKOnly+64
End If
Else
On Error Resume Next
End If
Next
n=iCount
Tot = arrFiles.Count
End Sub |
Partager