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

如何解决将在所有子文件夹上执行的 VBS 脚本

更新-----

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

文件夹结构：位置>块#>字母（由3个文件夹A、B和C组成）>房间（每个字母有4个子文件夹）>图片（每个子文件夹都有我要重命名的图片）

回顾一下，我希望能够将脚本与块#放在同一文件夹中，并在每个子文件夹的最后一个文件夹中的图片上执行。所以在我运行脚本后，每张图片都应该被重命名为 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

解决方法

应该这样做：

我重新设计了 ' Build the new file name. 部分，以使用 fso.GetParentFolderName() 正确获取文件的父文件夹，以“保持其在文件夹方案中的位置”。还使用 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