Rename files

[ChrisUK]

Hi,

I have written the following code to run through the files in a named folder and identify any charactors in a second sheet and then replace with a given replacement.

This works perfectly well except it doesn't go through any sub folders it finds, which is a little annoying

Any one suggest how I can alter the code to run through sub folders please?

Thanks

Chris

Sub RenameImages()

Dim strfile As String
Dim Filename As String
Dim loopCount As Integer

'Dim fso As Object
'Set fso = VBA.CreateObject("Scripting.FileSystemObject")

'Clear the old filelist
Worksheets("Master").Range("A2:A9999").Clear

'Setup a counter to point to cells A2 as A1 is where the header is stored
loopCount = 2

FileDetails = Worksheets("Master").Range("A1")
'Check to make sure last charactor of file name is a \
If Mid(FileDetails, Len(FileDetails), 1) <> "" Then
x = MsgBox("File Name must end in a '\' character (E.G. t:\Docs\folder1\ )", vbCritical, "Bad File Name")
GoTo EndSub
End If

'Get filename from A1 in the master worksheet
strfile = Dir(FileDetails)

'Main routine - cycles through the folder and searches for any file containing and charactor or phrase in the replace worksheet
'column A. If one is found then replace it with what is in column B at the same row
Do While (strfile <> "")
Filename = strfile
r = 2
Do While (Worksheets("Replace").Cells(r, 1) <> "")
Filename = Replace(Filename, Worksheets("Replace").Cells(r, 1), Worksheets("Replace").Cells(r, 2))
r = r + 1
Loop

'Has the file name changes?
If strfile <> Filename Then
'Yes ... then rename it and make a note in the master worksheet
Name Worksheets("Master").Range("A1") + strfile As Worksheets("Master").Range("A1") + Filename
Worksheets("Master").Cells(loopCount, 1) = strfile + " NOW " + Filename
loopCount = loopCount + 1
End If

'Get next file in folder
strfile = Dir()

Loop

EndSub:

End Sub

 

[HackSlash]

You need to add a new sub that looks for folders and then runs your "RenameImages" with each one found. For this to work you have to modify your "RenameImages" sub to accept the subdirectory as it's input path.

Sub RenameImages(FileDetails)

Try working with the example given here:

https://www.codeproject.com/questions/549737/recursiveplusdirectorypluslistingspluswithplusvba

It's written really well.

 

[ChrisUK]

Thanks, this is really helpful.

Chris