Solved

Search and replace in multiple files in subfolders

Posted on 2013-01-10
6
2,065 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
Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 

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

I would like to show you some basics you can do with Mailings in MS Word. It´s quite handy feature you can use for creating envelopes, labels, personalized letters etc. First question could be what is this feature good for? Mailing can really he…
Microsoft Word is a program we have all encountered at some point, but very few of us have dug deep into its full scope of features, let alone customized it to suit our needs. Luckily making the ribbon (aka toolbar, first introduced in Word 2007) wo…
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
If you’ve ever visited a web page and noticed a cool font that you really liked the look of, but couldn’t figure out which font it was so that you could use it for your own work, then this video is for you! In this Micro Tutorial, you'll learn yo…

734 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