[解决]纯数字连续文件名“添0”“补齐位数”，用批处理及VBS怎么写？

上帝是笨蛋

这是我常用的一个脚本，希望对你有用。
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

上帝是笨蛋

netmjwork 发表于 2018-3-22 20:51
对了，您能用VBS帮忙写一个代码吗？如果能用VBS实现那更方便，运行后也没有弹出窗口，谢谢！
按楼上“do ...

   On Error Resume Next
   
   Dim objFSO, objFolder, objFile, strSuffix, mArray(), oldName, newName, I, n
   
   Set objFSO = CreateObject("Scripting.FileSystemObject")
   Set objFolder = objFSO.GetFolder(".")
   ReDim mArray(0)
   
   For Each objFile In objFolder.Files
       strSuffix = LCase(objFSO.getextensionname(objFile))
       If strSuffix <> "vbs" Then
          If Err.Number = 0 Then
             ReDim Preserve mArray(UBound(mArray) + 1)
             mArray(UBound(mArray)) = objFile.Path
          Else
             MsgBox "Error：" & Err.Description & Chr(10) & Err.Number, vbOKOnly, "程序运行错误，将退出……"
             Exit For
          End If
       End If
   Next

   For n = 1 To UBound(mArray)
       strSuffix = LCase(objFSO.getextensionname(mArray(n)))
       newName = objFolder.Path & "\" & Right(String(8, "0") & objFSO.GetFileName(mArray(n)), 9 + Len(strSuffix))
       objFSO.Movefile mArray(n), newName
       If Err.Number <> 0 Then
          MsgBox "Error：" & Err.Description & Chr(10) & Err.Number, vbOKOnly, "程序运行错误，将退出……"
          Exit For
       End If
   Next
   Set objFile = Nothing
   Set objFolder = Nothing
   Set objFSO = Nothing