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
| Option Explicit
Dim File,MyRootFolder
MyRootFolder = Browse4Folder
Call Scan4File(MyRootFolder)
MsgBox "Script Done !",VbInformation,"Script Done !"
'**************************************************************************
Function Browse4Folder()
Dim objShell,objFolder,Message
Message = "Please select a folder in order to scan into it and its subfolders to rename files"
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0,Message,0,0)
If objFolder Is Nothing Then
Wscript.Quit
End If
Browse4Folder = objFolder.self.path
End Function
'**********************************************************************************************
Function Scan4File(Folder)
Dim fso,objFolder,arrSubfolders,File,SubFolder,NewFileName
Set fso = CreateObject("Scripting.FileSystemObject")
Set objFolder = fso.GetFolder(Folder)
Set arrSubfolders = objFolder.SubFolders
For Each File in objFolder.Files
NewFileName = Replace(File.Name,"_"," ")
MsgBox "Old File ==> " & File.Name & Vbcr & "New File Name ==> " & NewFileName,Vbinformation,"Rename File"
Call RenameFile(File,NewFileName)
Next
For Each SubFolder in objFolder.SubFolders
'Call Scan4File(SubFolder)
Next
End Function
'**********************************************************************
Sub RenameFile(File1,File2)
Dim Ws,Command,Execution
Set Ws = CreateObject("WScript.Shell")
Command = "Cmd /c Ren "& DblQuote(File1) &" "& DblQuote(File2) &""
'MsgBox Command
Execution = Ws.Run(Command,0,False)
End Sub
'**********************************************************************
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'********************************************************************** |
Partager