Search code examples
vbscriptsubdirectoryfile-rename

VBS Script that will execute on all subfolders


Update-----

My vbs script should take camera photos and rename them from a unique name like "0634_IMG" to a recursive number from 01 to 100. For example say there are 3 photos in the folder: 001_IMG, 003_IMG, and 006_IMG my script should rename these files to 01, 02, and 03 respectively. I have a version that works when I drag and drop the script into the specific folder, but there are 1000's of folders so I want to be able to place it into the parent folder and it execute on all subfolders. So it should be a folder drill down that only looks for files with the extension GIF, IMG, and PNG.

Folder Structure: Location>Block#>Letter(comprised of 3 folders A, B, and C)>Chamber(for each letter there are 4 subfolders)>Pictures (each subfolder has the pictures I am trying to rename)

so to review, I want to be able to put the script in the same folder as the block# and it execute on the pictures in the last folder for every subfolder. So after I run the script each picture should be renamed 01-100 and maintain its position within the folder scheme.

Thanks to the help of CHNguyen, my code was edited so that it would maintain the folder structure I describe above.

The issue now is that the script is numbering the pictures in every folder continuously and does not start or restart at 1.... For example after executing the script, Folder 1 (which contains 30 images) is outputting file names 830-860, when it should be 1-30. Additionally, the other subfolders have this same issue and it seems that the count or "intFileParts" is not being reset and I can't get it to reset.

I ask the coding gods for help as I am a newb and thanks in advance.

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


Solution

  • This should do:

    I reworked the ' Build the new file name. section to properly get the file's parent folder using fso.GetParentFolderName() to "maintain its position within the folder scheme". The padding and incrementing of the numeric value in the filename was also improved/simplified using VB and fso methods.

    The "missing" code under ' Use the MoveFile method to rename the file. was also added to perform the rename via fso.MoveFile()

    Code:

    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