Solved

Search and replace in multiple files in subfolders

Posted on 2013-01-10
6
1,922 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
  • 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
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 

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

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
copying from excel to word 2 45
add more styles to my code 2 50
Regarding Notepad++ 4 41
Deleting Unselectable Lines in Word 2013 2 46
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…
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…
This video teaches the viewer how to align pictures around text while keeping the text properly aligned in the document.
This video walks the viewer through the process of creating Hyperlinks for the web and other documents. Select the "Insert" tab: Click "Hyperlink":  Type "http://" followed by a web address to reference a website or navigate to a document to ref…

815 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now