用VBscript实现批量替换文件名,文件夹名

有这么一些文件,比如:
照片_001.jpg
照片_002.jpg
照片_003.jpg
有时候因为某种需要,想把“照片”批量改为自己定义的好听的名字,比如改为
avill_001.jpg
avill_002.jpg
avill_003.jpg
假如有1000张甚至更多的图片时,用手动来改的话不把你累死,也会被烦死的。
正因为这种需要,又不想安装什么软件。就直接用vbScript来实现了,即简单又方便,只要把下面的代码复制保存为 rename.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()
  
dim  s,folderPath,repWord,resWord
  folderPath 
=   " F:\Exercise\xhtml_info\taobao_images "
  folderPath 
=   ""
  folderPath 
=   InputBox ( " 批量替换文件名称 " &  vbcrlf  & " 请输入路径[绝对路径] " , "" )
  
  
  
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

call  reName()


同样地,下面的代码是实现批量替换文件夹名称,复制下面代码保存为 refolder.vbs 用法同上.

'  批量替换文件夹名称
'
 author : avill
'
 update : 2006.2.26
'

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 ( " 请输入路径[绝对路径],为空则自动退出 " , "" )
     
call  isFolderExists(fso,folderPath)     
  
end   if
end function

Function  doRepWord(Files,repWord,resWord)

    
Dim  S,file,count
        repWord 
=   split (repWord, " ; " )
        count 
=   0
        
For   Each  File In Files
          
for   each  repStr in repWord
          
if   instr (File.Name,repStr) <> 0   then
             file.name 
=   replace (file.name,repStr,resWord)
             count 
=  count  +   1
          
end   if
          
next  
        
Next

    doRepWord 
=  count

End Function

sub  reName()
  
dim  s,folderPath,repWord,resWord
  folderPath 
=   " F:\Exercise\xhtml_info\taobao_images "
  folderPath 
=   InputBox ( " 批量替换文件夹名称 " &   chr ( 13 & " 请输入路径[绝对路径] " , "" )
  
  
  
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.SubFolders

  
If   1   =  Files.Count  Then
     S 
=  S  &   " There is only 1 folder "    & NewLine
  
Else
     S 
=  S  &   " There are  "   &  Files.Count  & "  folders  " & NewLine
  
End   If

  
If  Files.Count  <>   0   Then
     s 
=  s  &   " replace folderName: "   &  doRepWord(Files,repWord,resWord)  & NewLine
  
End   If


if   1   =   2   then

  
Set  Files  =  Folder.Files
 
  
If   1   =  Files.Count  Then
     S 
=  S  &   " There is 1 file "   &  NewLine
  
Else
     S 
=  S  &   " There are  "   &  Files.Count  &   "  folders "   &  NewLine
  
End   If

  
If  Files.Count  <>   0   Then
     s 
=  s  &   " replace folder: "   &  doRepWord(Files,repWord,resWord)  & NewLine
  
End   If

end   if

  
msgbox  s 
  
end sub

call  reName()

你可能感兴趣的:(VBScript)