Dim ar
Set ar = WScript.Arguments
If ar.Count = 0 Then
MsgBox “请把包含要按顺序Rename的文件的文件夹拖放到本程序的图标上!”, 4160, “提示”
Set ar = Nothing
WScript.Quit
End If
Public szExt, szExtNew, l, mf, r, fso, a
szExt = InputBox(“请输入要Rename的文件后缀名:”, “确定文件类型”, “bin”)
szExt = Trim(szExt)
While Left(szExt, 1) = “.”
szExt = Mid(szExt, 2)
Wend
szExt = “.” & szExt
l = Len(szExt)
If l < 1 Then
MsgBox “后缀名太短!”, 4112, “错误”
Set ar = Nothing
WScript.Quit
End If
szExtNew = InputBox(“请输入要Rename后文件的后缀名:”, “确定改后的后缀名”, “bmp”)
szExtNew = Trim(szExtNew)
While Left(szExtNew, 1) = “.”
szExtNew = Mid(szExtNew, 2)
Wend
szExtNew = “.” & szExtNew
If Len(szExtNew) < 1 Then
MsgBox “后缀名太短!”, 4112, “错误”
Set ar = Nothing
WScript.Quit
End If
mf = InputBox(“请输入存放Rename后文件的文件夹:”, “确定存放文件夹”, ar(0))
mf = Trim(mf)
While Right(mf, 1) = “\”
mf = Left(mf, Len(mf) – 1)
Wend
r = MsgBox(“处理后是否删除原文件?”, 4131, “确定移动还是复制”)
If r = 2 Then WScript.Quit
Set fso = CreateObject(“Scripting.FileSystemObject”)
If Not fso.FolderExists(mf) Then
MsgBox “用来存放Rename后的文件的文件夹不存在!”, 4112, “错误”
Set ar = Nothing
Set fso = Nothing
WScript.Quit
End If
For Each a In ar
If fso.FolderExists(a) Then Call Rename(a)
Next
Set ar = Nothing
Set fso = Nothing
MsgBox “整个世界清净了!”, 4160, “搞定!”
Private Sub Rename(ByVal fd)
Dim rfd, fs, f, p
Set rfd = fso.GetFolder(fd)
Set fs = rfd.Files
For Each f In fs
If StrComp(Right(f.Name, l), szExt, 1) = 0 Then
p = mf & “\” & Left(f.Name, Len(f.Name) – l) & szExtNew
‘ MsgBox p
If Not fso.FileExists(p) Then
If r = 6 Then
f.Move p
Else
f.Copy p
End If
End If
End If
Next
Set fds = rfd.SubFolders
For Each fd In fds
Rename fd.Path
Next
End Sub