ChrisUK
Well-known Member
- Joined
- Sep 3, 2002
- Messages
- 675
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
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