PDA

View Full Version : [SOLVED] Having trouble with renaming files in subfolders of subfolders



ashleyuk1984
02-19-2018, 02:22 AM
Hi,
I'm attempting to rename any files that have specific characters in the filename.

I've got a macro which will do this... But it will only look in 'one layer' of the subfolders.

So if I set my Path as "C:\Ash"

Then anything within one subfolder layer of the path will rename perfectly fine (as long as the criteria is met):
"C:\Ash\111" or "C:\Ash\222" or "C:\Ash\333"

But if there is another layer of subfolders, the macro won't touch it.
"C:\Ash\111\AnotherLayer" or "C:\Ash\222\AnotherLayer" or "C:\Ash\333\AnotherLayer"




Sub RenameFilesInAllSubFolders()
Dim fso As Object, fold As Object, fFile As Object
Dim fPath As String, fName As String, oldName As String, newName As String

'Set File Path
fPath = "C:\Ash"

Set fso = CreateObject("Scripting.FileSystemObject")
Set fold = fso.GetFolder(fPath)

For Each fFile In fold.SubFolders

fName = Dir(fFile.Path & "\*.*", vbNormal)

'If the filename contains any of these characters then replace them with a 'space'
TestCharacter1 = "&"
TestCharacter2 = "#"
TestCharacter3 = "+"

'Loop through the subfolders and test files for criteria
Do While fName <> ""

If InStr(1, fName, TestCharacter1, vbTextCompare) > 1 Then

oldName = fName
newName = Application.WorksheetFunction.Substitute(fName, TestCharacter1, " ")
Name fFile.Path & "\" & fName As fFile.Path & "\" & newName

ElseIf InStr(1, fName, TestCharacter2, vbTextCompare) > 1 Then

oldName = fName
newName = Application.WorksheetFunction.Substitute(fName, TestCharacter2, " ")
Name fFile.Path & "\" & fName As fFile.Path & "\" & newName

ElseIf InStr(1, fName, TestCharacter3, vbTextCompare) > 1 Then

oldName = fName
newName = Application.WorksheetFunction.Substitute(fName, TestCharacter3, " ")
Name fFile.Path & "\" & fName As fFile.Path & "\" & newName

Else
End If

fName = Dir

Loop
Next

End Sub



How can I modify the above code to make it search in all layers of subfolders... Sometimes, there could be 6 or 7 layers.

Thanks

snb
02-19-2018, 02:38 AM
I'd rather replace than adapt your code.
This is all you need:


Sub M_snb()
sn=split("& # +")

with createobject("wscript.shell")
for j=0 to ubound(sn)
sp=split(.exec("cmd /c dir ""C:\Ash\*"& sn(j) & "*.*"" /b/s/a-d").stdout.readall,vbcrlf)

for each it in sp
name it as replace(it,sn(j)," ")
next
next
end with
End Sub

ashleyuk1984
02-19-2018, 03:44 AM
Thank you very much snb. Worked perfectly, and very fast!