将在所有子文件夹上执行的 VBS 脚本

Question

更新-----

我的 vbs 脚本应该拍摄相机照片并将它们从唯一名称（如“0634_IMG”重命名为从 01 到 100 的递归数字。例如，文件夹中有 3 张照片：001_IMG、003_IMG 和 006_IMG 我的脚本应将这些文件分别重命名为 01、02 和 03。当我将脚本拖放到特定文件夹时，我有一个版本可以工作，但是有 1000 个文件夹，所以我希望能够将它放入父文件夹并在所有子文件夹上执行。所以它应该是一个文件夹下钻，只查找扩展名为 GIF、IMG 和 PNG 的文件。

文件夹结构：Location>Block#>Letter（由 3 个文件夹 A、B 和 C 组成）>Chamber（每个字母有 4 个子文件夹）>Pictures（每个子文件夹都有我要重命名的图片)

回顾一下，我希望能够将脚本放在与块# 相同的文件夹中，并在每个子文件夹的最后一个文件夹中的图片上执行。所以在我运行脚本之后，每张图片都应该重命名为 01-100 并保持其在文件夹方案中的位置。

感谢 CHNguyen 的帮助，我的代码得到了编辑，因此它可以保持我上面描述的文件夹结构。

现在的问题是脚本对每个文件夹中的图片连续编号，而不是从1开始或重新开始....例如执行脚本后，文件夹1（包含30张图片）正在输出文件命名 830-860，而它应该是 1-30。此外，其他子文件夹也有同样的问题，似乎计数或“intFileParts”没有被重置，我无法重置它。

新手求大神们帮忙，先谢过

Option Explicit

Dim fso
Dim oFolder, oSubFolder
Dim oFile
Dim sPath, strOldName, strNewName
Dim intFileParts

' Create the instance of the fso.
Set fso = CreateObject("Scripting.FileSystemObject")

' Set the folder you want to search.
sPath = fso.GetFolder(fso.GetAbsolutePathName(".")) + "\"
RenameFiles(sPath)

Sub RenameFiles(Path)
    Set oFolder = fso.GetFolder(Path)

    intFileParts = 1 ' Restart at 1

    ' Loop through each file in the folder.    
    For Each oFile In oFolder.Files
        ' Only select images
        Select Case oFile.Type
            Case "GIF Image", "JPG Image", "PNG Image"
        End Select

        ' Get complete file name with path.
        strOldName = oFile.Path

        ' Build the new file name.
        strNewName = ""
        strNewName = fso.GetParentFolderName(oFile) & "\" & Right("000" & fso.GetBaseName(oFile), 3) & "." & fso.GetExtensionName(oFile)
        
        ' Use the MoveFile method to rename the file.
        fso.MoveFile strOldName, strNewName

        intFileParts = intFileParts + 1
    Next

    For Each oSubFolder In oFolder.Subfolders
        RenameFiles(oSubFolder.Path)
    Next
End Sub

Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing

Answer 1

应该这样做：

我修改了 ' Build the new file name. 部分以使用 fso.GetParentFolderName() 正确获取文件的父文件夹以“保持其在文件夹方案中的位置”。文件名中数值的填充和递增也是 improved/simplified 使用 VB 和 fso 方法。

还添加了 ' Use the MoveFile method to rename the file. 下的“缺失”代码以通过 fso.MoveFile()

执行重命名

代码：

Option Explicit

Dim fso
Dim oFolder, oSubFolder
Dim oFile
Dim sPath, strOldName, strNewName
Dim intFileParts

' Create the instance of the fso.
Set fso = CreateObject("Scripting.FileSystemObject")

' Set the folder you want to search.
sPath = fso.GetFolder(fso.GetAbsolutePathName(".")) + "\"
RenameFiles(sPath)

Sub RenameFiles(Path)
    Set oFolder = fso.GetFolder(Path)

    intFileParts = 1 ' Restart at 1

    ' Loop through each file in the folder.    
    For Each oFile In oFolder.Files
        ' Only select images
        Select Case oFile.Type
            Case "GIF Image", "JPG Image", "PNG Image"
        End Select

        ' Get complete file name with path.
        strOldName = oFile.Path

        ' Build the new file name.
        strNewName = ""
        strNewName = fso.GetParentFolderName(oFile) & "\" & Right("000" & intFileParts, 3) & "." & fso.GetExtensionName(oFile)
        
        ' Use the MoveFile method to rename the file.
        fso.MoveFile(strOldName, strNewName)

        intFileParts = intFileParts + 1
    Next

    For Each oSubFolder In oFolder.Subfolders
        RenameFiles(oSubFolder.Path)
    Next
End Sub

Set oFile = Nothing
Set oSubFolder = Nothing
Set oFolder = Nothing
Set fso = Nothing

将在所有子文件夹上执行的 VBS 脚本

VBS Script that will execute on all subfolders

vbscript

subdirectory

file-rename