'Batch replace file names
'Author: avill
'Upate: 2006.2.28
'
Dim newline
Newline = vbcrlf
Tabstop = ""
Function isfolderexists (FSO, folderpath)
If folderpath = empty then exit function
If not FSO. folderexists (folderpath) then
Msgbox "foloder not exists! Please try agian"
Folderpath = inputbox ("batch replace file name" & vbcrlf & "Enter the path [absolute path]. If it is null, the system automatically exits ","")
Call isfolderexists (FSO, folderpath)
End if
End Function
Function dorepword (files, filepath, repword, resword)
Dim S, file, Count, newname
Repword = Split (repword ,";")
Count = 0
Set FSO = Createobject ("scripting. FileSystemObject ")
For each file in files
For each repstr in repword
If instr (file. Name, repstr) <> 0 then
Newname = Replace (file. Name, repstr, resword)
If not FSO. fileexists (filepath & "\" & newname) then
'Msgbox "exists"
File. Name = newname
Count = count + 1
End if
End if
Next
Next
Dorepword = count
End Function
Sub Rename (PATH)
Dim S, folderpath, repword, resword
'Folderpath = "F: \ exercise \ xhtml_info \ taobao_images" 'absolutive path
'Folderpath = ""
'Folderpath = inputbox ("replacing file names in batches" & vbcrlf & "Enter the path [absolute path]", "")
Folderpath = path
Set FSO = Createobject ("scripting. FileSystemObject ")
Call isfolderexists (FSO, folderpath)
If folderpath = empty then exit sub
Repword = inputbox ("the character to be replaced. Separate multiple characters with semicolons! ","")
Resword = inputbox ("you want to replace the character :! ","")
Set folder = FSO. getfolder (folderpath)
Set files = folder. Files
If 1 = files. Count then
S = S & "there is 1 file" & newline
Else
S = S & "there are" & files. Count & "Files" & newline
End if
If files. Count <> 0 then
S = S & "replace files:" & dorepword (files, folderpath, repword, resword) & newline
End if
Msgbox s
End sub
Set objshell = Createobject ("wscript. Shell ")
'Msgbox objshell. currentdirectory
Call Rename (objshell. currentdirectory)