Solved

Search and replace in multiple files in subfolders

Posted on 2013-01-10
6
1,909 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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Like many others, we try and discourage users from printing documents unnecessarily and instead send or share them electronically. However, this doesn't always work and documents are still printed. With this simple solution, if the user tries to …
The Selection object is designed for user interaction. It has a Range property, so it can be used in most places that a Range object can. Recorded macros must use the Selection because they are simply copying what the user is doing. A Range prope…
This video teaches the viewer how to align pictures around text while keeping the text properly aligned in the document.
This Micro Tutorial well show you how to find and replace special characters in Microsoft Word. This is similar to carriage returns to convert columns of values from Microsoft Excel into comma separated lists.

863 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

19 Experts available now in Live!

Get 1:1 Help Now