Replace text in word file in all sub folders

Question

I am putting together a VBA macro that:

1.reads a folder

2.creates a collection of all its subfolders

3.loops through all the subfolders and find any word document ending in .doc

4.in each .doc file: replace a bit of text and save then close the documents.

This macro doesn't work correctly: it doesn't replace the text in any word documents in the subfolders. It doesn't actual open any word document, I am unsure wether it should open each word doc one after another or if it runs in the background.

Sub DoLangesNow()
Dim file
Dim path As String
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant

 ' Parent folder including trailing backslash
 'YOU MUST EDIT THIS.
     strFolder = "G:\2009\09771\Design\ESD\Commercial Tower KSD1\Green Star As Built\Round 1 Submission - Draft\02. Indoor Environment Quality"

     ' Loop through the subfolders and fill Collection object
     strSubFolder = Dir(strFolder & "*", vbDirectory)
     Do While Not strSubFolder = ""
         Select Case strSubFolder
             Case ".", ".."
                 ' Current folder or parent folder - ignore
             Case Else
                 ' Add to collection
                 colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
         End Select
         ' On to the next one
         strSubFolder = Dir
     Loop
     ' Loop through the collection
     For Each varItem In colSubFolders
         ' Loop through word docs in subfolder
         'YOU MUST EDIT THIS if you want to change the files extension
         strFile = Dir(strFolder & varItem & "*.doc")
         Do While strFile <> ""
         Set file = Documents.Open(FileName:=strFolder & _
                 varItem & "\" & strFile)

' Start of macro 1replace text GS-XXXAB  with GS-1624AB
'
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = ""
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Application.WindowState = wdWindowStateNormal
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "GS-XXXAB "
        .Replacement.Text = "GS-1624AB "
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
' End of macro 1
' Saves the file
ActiveDocument.Save
ActiveDocument.Close
' set file to next in Dir
strFile = Dir
         Loop
     Next varItem
 End Sub

Santosh Santosh · Accepted Answer · 2013-06-04T02:16:55

Your code worked for me with below changes

From

    strFile = Dir(strFolder & varItem & "*.doc")

To

  strFile = Dir(strFolder & varItem & "\" & "*.doc")

Make sure the path for folder is correct in strFolder Variable. Eg( strFolder = "C:\Users\Santosh\Desktop\tes\")

Replace text in word file in all sub folders

1 Answers