' Script to list/rename files (sub-dirs included) based off of a file called rename.txt in the same directory.
' Set bRename to true to actually rename files rather than just echo what will take place.

'Constants
RENAME_FILE = "rename.txt"                      ' case sensitive 'special' file to find in each directory.

'Globals
bRename        = false                          ' always prints out, set this to true to perform rename
objStartFolder = "C:\Users\user\Desktop\Test"  ' top level folder to search from, no trailing backslash

wscript.echo ""
wscript.echo "Top folder to process:   " & objStartFolder
wscript.echo "Action Mode:             " & bRename & vbcrlf

dim objFSO    : set objFSO = CreateObject("Scripting.FileSystemObject")
dim objFolder : set objFolder = objFSO.GetFolder(objStartFolder)

' Note: If the 'special' file (RENAME_FILE) doesn't exist then strNewFile is set to -1 otherwise the new filename from the file contents
strNewFile = GetNewFileName (objFolder.Path)

if strNewFile <> "-1" then
 'we have a rename.txt
  wscript.echo RENAME_FILE & " found in '" & objFolder.Path & "' and contains the text '" & strNewFile & "' to base filenames off."

  'Process root level files in the top directory
  Set colFiles = objFolder.Files
    dim intRoot : intRoot = 1
    For Each objFile in colFiles
       if objFile.Name <> RENAME_FILE then
          strNewFileName = strNewFile & intRoot & GetExtension (objFolder.Path & "\" & objFile.Name)
          wscript.Echo "found file " & objFolder.Path & "\" & objFile.Name & " rename to " &  strNewFileName
          if bRename then
             objFSO.MoveFile objFolder.Path & "\" & objFile.Name, strNewFileName
          end if

          intRoot = intRoot + 1
       end if
    Next
else
  wscript.echo "No " & RENAME_FILE & " in " & objFolder.Path & ".  Skipping..."
end if

wscript.echo ""

ShowSubfolders objFSO.GetFolder(objStartFolder)

Sub ShowSubFolders(Folder)
    For Each Subfolder in Folder.SubFolders

        wscript.echo "Folder to process " & Subfolder.Path
        strNewFile2 = GetNewFileName (Subfolder.Path)

        if strNewFile2 <> "-1" then
        'we have a rename.txt
          wscript.echo RENAME_FILE & " found in '" & Subfolder.Path & "' and contains the text '" & strNewFile2 & "' to base filenames off."
          Set colFiles = Subfolder.Files
            dim intRoot : intRoot = 1
            For Each objFile in colFiles
               if objFile.Name <> RENAME_FILE then
                  strNewFileName2 = strNewFile2 & intRoot & GetExtension (objFolder.Path & "\" & objFile.Name)
                  wscript.Echo "found file " & Subfolder.Path & "\" & objFile.Name & " rename to " &  strNewFileName2
                  if bRename then
                    objFSO.moveFile Subfolder.Path & "\" & objFile.Name, strNewFileName2
                  end if

                  intRoot = intRoot + 1
               end if
            Next
        else
          wscript.echo "No " & RENAME_FILE & " in " & Subfolder.Path & ".  Skipping..."
        end if

        Wscript.Echo ""
        ShowSubFolders Subfolder

    Next

End Sub

'=======================
'Functions
'=======================
Function GetNewFileName (strLocation)

    If (objFSO.FileExists(strLocation & "\" & RENAME_FILE)) Then
        Set file = objFSO.OpenTextFile (strLocation & "\" & RENAME_FILE , 1)
        Do Until file.AtEndOfStream
          GetNewFileName = file.Readline
        Loop
    else
        GetNewFileName = "-1"
    end if

End Function
'=======================

'=======================
Function GetExtension (strFullFilePath)

    strExtension = objFSO.getextensionname(strFullFilePath)

    if  strExtension <> "" then
       GetExtension = "." & strExtension
    else
       GetExtension = ""
    end if

End Function
'=======================