分享用VBscript实现批量替换文件名，文件夹名
2012年4月11日星期三 | | |有这么一些文件，比如:
照片_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()
照片_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 NewLineNewLine = vbcrlfTabStop = ""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 ifend functionFunction 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 = countEnd Functionsub 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 subcall reName()同样地，下面的代码是实现批量替换文件夹名称，复制下面代码保存为 refolder.vbs 用法同上.
' 批量替换文件夹名称' author : avill' update : 2006.2.26'Dim NewLineNewLine = vbcrlfTabStop = ""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 ifend functionFunction 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 = countEnd Functionsub 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 Ifif 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 Ifend if msgbox s end subcall reName()参考: http://www.cnblogs.com/avill/archive/2006/03/02/341424.html
博文
