I'm rusty so I'm sure I'm missing something silly. I have a folder with ~50 mp4 files, all with sequentially numbered filenames like 33.mp4, 34.mp4
etc. I simply need to rename them starting with 1.mp4, 2.mp4
etc. The code looks in the current directory, makes sure the extension is mp4, and then goes to town. If I start intCounter
at 1, all works great. But if for example I set intCounter
to 80 (making sure the filenames don't already have 80 or above) and then run the script, it seems to loop through the files more than once and I end up with file names in the hundreds. What is going on here?
Dim objFSO, objFolder, intCounter
Set objFSO = CreateObject("Scripting.FileSystemobject")
Set objFolder = objFSO.GetFolder(objFSO.GetAbsolutePathName("."))
intCounter = 1
For Each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile) = "mp4" Then
objFSO.MoveFile objFile, intCounter & ".mp4"
intCounter = intCounter + 1
End If
Next
Set objFSO = Nothing
Set objFolder = Nothing
Changing the contents of the folder, by renaming files, affects the list being processed by the For Each loop, leading to the unexpected results.
The original code is written with the assumption that the For Each loop will gather the list of files in the folder just once at the beginning of the loop and will not be affected by changes to the folder while the loop is executing. However, that is only true for a small number of files (i.e. 32 or fewer). For more details see:
VBS: For-each loop (sometimes) iterates through file collection indefinitely
One solution is to use the For Each loop to build an array of file names and then process that array to rename the files. However, there would still need to be additional code to handle potential "File already exists" errors if the files are renamed in place.
A simpler solution is to move the files to a new subfolder as they are renamed. That will prevent any issues with the For Each loop and avoid any renaming conflicts. Eliminating files from the original folder as they are being renamed does not cause any problem.
Here's a revised version of the script that moves the files to a new, unique subfolder as they are renamed:
Dim objFSO, objFolder, intCounter, TargetFolder
Set objFSO = CreateObject("Scripting.FileSystemobject")
Set objFolder = objFSO.GetFolder(objFSO.GetAbsolutePathName("."))
intCounter = 1
TargetFolder = ".\Renamed_Files_" & Replace(Replace(Replace(Now(),"/",""),":","")," ","") & "\"
objFSO.CreateFolder(TargetFolder)
For Each objFile In objFolder.Files
If objFSO.GetExtensionName(objFile) = "mp4" Then
objFSO.MoveFile objFile, TargetFolder & intCounter & ".mp4"
intCounter = intCounter + 1
End If
Next
Set objFSO = Nothing
Set objFolder = Nothing