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
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