Solved

Search and replace in multiple files in subfolders

Posted on 2013-01-10
6
2,107 Views
Last Modified: 2013-01-11
Dear Experts:

below code, which works just fine, performs a search and replace actions on multiple files in a given directory. C:\test\

I would like to run this code on subfolders as well, ie. in the above case, there are several folders under C:\test\, ie.
C:\test\test1,
C:\test\test2,
C:\test\test3,
C:\test\test4,
C:\test\test5

How is the code to be rewritten so that subfolders also get worked on.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas

Sub SearhAndReplace_MultipleFiles()
   Dim strFile As String
   Dim i As Integer
   Dim doc As Document
   Dim rng As Range

    
    Const strFolder = "C:\test\"
    
    strFile = Dir$(strFolder & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)
        
        For Each rng In doc.StoryRanges
        
                    With rng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = "Rev. 1.0"
                        .Replacement.Text = "Rev 1.1"
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Open in new window

0
Comment
Question by:AndreasHermle
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 3
6 Comments
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38766195
Try:

Option Explicit

Sub SearchAndReplace_MultipleFiles()
Dim fso As Object
Dim ROOT As Object
Dim fldr As Object
    
    Const strFolder = "C:\test\"
    Set fso = CreateObject("scripting.filesystemobject")
    If Not fso.folderexists(strFolder) Then
        MsgBox "Folder '" & strFolder & "' not found - Exiting routine", , "Error"
        Exit Sub
    End If
    Set ROOT = fso.getfolder(strFolder)
    processFolder ROOT.Path
    For Each fldr In ROOT.subfolders
        processFolder fldr.Path
    Next
    
End Sub

Sub processFolder(strFolder As String)
Dim strFile As String
Dim doc As Document
Dim rng As Word.Range


    strFile = Dir$(strFolder & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)
        
        For Each rng In doc.StoryRanges
        
                    With rng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = "Rev. 1.0"
                        .Replacement.Text = "Rev 1.1"
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Open in new window


Call SearchAndReplace_MultipleFiles, 'improved' the name spelling ;o) and this should do the job


Chris
0
 

Author Comment

by:AndreasHermle
ID: 38766243
Hi Chris,

thank you very much for your swift support.

I am afraid to tell you that the code does not work.

After hitting 'Do Until strFile = ""' the code does not proceed to the next line but goes straight to 'End Sub'

Any idea why?

Regards, Andreas
0
 
LVL 59

Expert Comment

by:Chris Bottomley
ID: 38766266
Apologies limited testing and overlooked sub call change:

Option Explicit

Sub SearhAndReplace_MultipleFiles()
Dim FSO As Object
Dim ROOT As Object
Dim fldr As Object
    
    Const strFolder = "C:\test\"
    Set FSO = CreateObject("scripting.filesystemobject")
    If Not FSO.folderexists(strFolder) Then
        MsgBox "Folder '" & strFolder & "' not found - Exiting routine", , "Error"
        Exit Sub
    End If
    Set ROOT = FSO.getfolder(strFolder)
    processFolder ROOT.Path
    For Each fldr In ROOT.subfolders
        processFolder fldr.Path
    Next
    
End Sub

Sub processFolder(strFolder As String)
Dim strFile As String
Dim doc As Document
Dim rng As Word.Range
Dim fileSet As Object

    strFile = Dir$(strFolder & "\" & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)
        
        For Each rng In doc.StoryRanges
        
                    With rng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = "Rev. 1.0"
                        .Replacement.Text = "Rev 1.1"
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Open in new window


i.e. tweaked line 28.

Chris
0
On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

 

Author Comment

by:AndreasHermle
ID: 38766344
Hi Chris,

thank you very much for your swift support.

I still get an error message on ...

Set doc = Documents.Open(strFolder &  strFile).

Runtime Error: 5174:
This file was not found:
C:\Test\test1Dok.docx

I guess we are almost there. The insertion of the backslash between the (sub-)folder name and actual file is not performed by the code.

Help is much appreciated. Thank you very much in advance.

Regards, Andreas
0
 
LVL 59

Accepted Solution

by:
Chris Bottomley earned 500 total points
ID: 38766456
Unfortunately

1. I do not have relevant files and structuure to edit
2. I'm being an idiot!

This should resolve the issue properly

Sub SearhAndReplace_MultipleFiles()
Dim FSO As Object
Dim ROOT As Object
Dim fldr As Object
    
    Const strFolder = "C:\test\"
    Set FSO = CreateObject("scripting.filesystemobject")
    If Not FSO.folderexists(strFolder) Then
        MsgBox "Folder '" & strFolder & "' not found - Exiting routine", , "Error"
        Exit Sub
    End If
    Set ROOT = FSO.getfolder(strFolder & "\")
    processFolder ROOT.Path
    For Each fldr In ROOT.subfolders
        processFolder fldr.Path & "\"
    Next
    
End Sub

Sub processFolder(strFolder As String)
Dim strFile As String
Dim doc As Document
Dim rng As Word.Range
Dim fileSet As Object

    strFile = Dir$(strFolder & "*.docx")
    Do Until strFile = ""
        Set doc = Documents.Open(strFolder & strFile)
        
        For Each rng In doc.StoryRanges
        
                    With rng.Find
                        .ClearFormatting
                        .Replacement.ClearFormatting
                        .Text = "Rev. 1.0"
                        .Replacement.Text = "Rev 1.1"
                        .Replacement.Font.Size = 9
                        .Forward = True
                        .Wrap = wdFindContinue
                        .Execute Replace:=wdReplaceAll
                    End With
                Next rng
        doc.Save
        doc.Close
        strFile = Dir$()
    Loop
End Sub

Open in new window

0
 

Author Closing Comment

by:AndreasHermle
ID: 38767045
Hi Chris,

really a great job! Thank you very much for your great support. This macro will save me hours of valuable time. I am so glad!

This is a great forum!
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

If you work with Word a lot, you probably use styles. If you use styles a lot, you've probably balled your fist more often than not when working with the ribbon. In Word 2007/2010, one of the things that I find missing when using styles is a quic…
This article shows how to get a list of available printers for display in a drop-down list, and then to use the selected printer to print an Access report or a Word document filled with Access data, using different syntax as needed for working with …
This video walks the viewer through the process of creating an MLA formatted document, as well as a bibliography with citations.
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …

623 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question