|
这是我常用的一个脚本,希望对你有用。
On Error Resume Next
Dim strSet, arrSet, strSuffix, selfName
Do While InStr(1, strSet, ",") = 0
strSet = InputBox("请按照“前辍+填充数字长度+指定更改的文件类型”方式输入参数,中间用逗号隔开。" & Chr(10) & "例:“ 三亚,5,jpg ”或“ *,6,* ”,“*”代表纯数字文件名或全部类型的文件。", "请输入重命名参数", "*,5,JPG")
strSet = Replace(Replace(Replace(strSet, ",", ","), " ", ""), " ", "")
If strSet = "" Then
MsgBox "没有输入任何有效参数,请继续……"
Else
arrSet = Split(LCase(strSet), ",")
If UBound(arrSet) < 2 Then
MsgBox "输入的参数不完整,请继续……"
strSet = ""
End If
End If
Loop
If arrSet(0) = "*" Then arrSet(0) = ""
If arrSet(1) = "*" Or arrSet(1) = "" Then arrSet(1) = 5
If arrSet(2) = "" Then arrSet(2) = "*" Else arrSet(2) = LCase(arrSet(2))
Dim objFSO, objFolder, objFile, strPath, oldName, newName, I
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(".")
I = 1
For Each objFile In objFolder.Files
strSuffix = LCase(objFSO.getextensionname(objFile))
If strSuffix <> "vbs" And (arrSet(2) = "*" Or arrSet(2) = strSuffix) Then
newName = arrSet(0) & String(CInt(arrSet(1)) - Len(CStr(I)) + 1, "0") & I & "." & strSuffix
objFile.Name = newName
If Err.Number = 0 Then
I = I + 1
Else
MsgBox "Error:" & Err.Description & Chr(10) & Err.Number, vbOKOnly, "程序运行错误,将退出……"
Exit For
End If
End If
Next
Set objFile = Nothing
Set objFolder = Nothing
Set objFSO = Nothing |
|