Text find and replace by file extension with sub directories

Hello,

Another user recently supplied a vbscript to find and replace multiple lines in multiple text files with the extension "abc".  The script works well but I need it to make the changes to all sub directories and not just the defined parent directory.  Please see the script below, I need this script to replace as defined in the script but include all sub directories in the search of D:

Thanks!

' Constants for I/O
Const ForReading = 1
Const ForWriting = 2

' Define folder to search
strBaseDir = "C:\Files\"
strBaseExt = ".ABC"

' Access the folder
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strBaseDir)

' Process each file in the folder
For Each objFile in objFolder.Files

    ' See if it matches the pattern of filenames we want
    If UCase(Right(objFile.Name, Len(strBaseExt))) = UCase(strBaseExt) Then

        ' Read the entire file
        strFile = objFile.Path
        Set objReader = objFSO.OpenTextFile(strFile, ForReading)
        strData = objReader.ReadAll
        objReader.Close

        ' Make desired replacements in the file
        strData = Replace(strData, "L:\somedir\somedir", "i:\newdir\newdir", 1, -1, vbTextCompare)
        strData = Replace(strData, "L:\somedir\somedir2", "i:\newdir\newdir2", 1, -1, vbTextCompare)
        strData = Replace(strData, "L:\somedir\somedir3", "i:\newdir\newdir3", 1, -1, vbTextCompare)

        ' Write the updated data back to the file
        Set objWriter = objFSO.OpenTextFile(strFile, ForWriting, True)
        objWriter.Write strData
        objWriter.Close

    End If

Next

Open in new window

crash1624Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Bill PrewCommented:
Give this a try, it will recursively dig down into all subfolders under the starting folder and process files in each of those as well.

Keep in mind that running this on a full disk drive will take quite a bit of time, and you may also run into some permissions errors on certain folders if you do not have access to them.

' Constants for I/O
Const ForReading = 1
Const ForWriting = 2

' Define folder to search
strBaseDir = "D:\"
strBaseExt = ".ABC"

' Access the folder
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(strBaseDir)

ProcessFolder(objFolder)

Sub ProcessFolder(objFolder)
   ' Process each file in the folder
   For Each objFile in objFolder.Files

       ' See if it matches the pattern of filenames we want
       If UCase(Right(objFile.Name, Len(strBaseExt))) = UCase(strBaseExt) Then

           ' Read the entire file
           strFile = objFile.Path
           Set objReader = objFSO.OpenTextFile(strFile, ForReading)
           strData = objReader.ReadAll
           objReader.Close

           ' Make desired replacements in the file
           strData = Replace(strData, "L:\somedir\somedir", "i:\newdir\newdir", 1, -1, vbTextCompare)
           strData = Replace(strData, "L:\somedir\somedir2", "i:\newdir\newdir2", 1, -1, vbTextCompare)
           strData = Replace(strData, "L:\somedir\somedir3", "i:\newdir\newdir3", 1, -1, vbTextCompare)

           ' Write the updated data back to the file
           Set objWriter = objFSO.OpenTextFile(strFile, ForWriting, True)
           objWriter.Write strData
           objWriter.Close

       End If

   Next

   ' Recusively process all subfolders of this one
   For Each objSubFolder In objFolder.Subfolders
      ProcessFolder(objSubFolder)
   Next

End Sub

Open in new window

~bp
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.