vbs批量替換文件名稱

' 批量替換文件名稱
' 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("批量替換文件名稱"& vbcrlf &"請輸入路徑[絕對路徑],爲空則自動退出","")
     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("批量替換文件名稱"& vbcrlf &"請輸入路徑[絕對路徑]","")
  folderPath=path
  
  
  Set fso = CreateObject("Scripting.FileSystemObject")
  call isFolderExists(fso,folderPath)
  if folderPath = empty then exit sub
  repWord = InputBox("希望要替換掉的字符,多個字符請用分號[;]隔開!","")
  resWord = InputBox("希望將字符替換爲:!","") 
 
  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)