CODEWITHSUNDEEP
vbaexcelms-word
Alex H
Alex H

Reputation: 39

MS Word Find and Replace text within all docs in a folder using VBA

I have come across the code below that searches through an open word document and performs a find and replace within all areas (StoryRanges) of the document. It works fine, however i would like to ask how i could modify this code to look at all documents in a chosen folder and perform the find and replace for all docs within that folder?, rather than just the active document which is open?

My plan is to assign the macro to a button in Excel so that the user can click that, navigate to the folder and action the find and replace across lots of documents at once.

Am I able to amend the 'IN ActiveDocument.StoryRanges' section to look at a folder instead? I'm not sure what i can amend it to. btw... i am new to vba and trying to research & learn as i go... I very much appreciate your time, patience and any help you can give while i'm trying to find my feet with it - Alex.

Dim myStoryRange As Range

    For Each myStoryRange In ActiveDocument.StoryRanges
    With myStoryRange.Find
        .Text = "Text to find to replace goes here"
        .Replacement.Text = "And the replacement text goes here"
        .Wrap = wdFindContinue
        .Execute Replace:=wdReplaceAll
    End With
    Do While Not (myStoryRange.NextStoryRange Is Nothing)
        Set myStoryRange = myStoryRange.NextStoryRange
        With myStoryRange.Find
            .Text = "Text to find to replace goes here"
            .Replacement.Text = "And the replacement text goes here"
            .Wrap = wdFindContinue
            .Execute Replace:=wdReplaceAll
        End With
    Loop
Next myStoryRange

Upvotes: 2

Views: 11878

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149277

I have commented the code so you shouldn't have any problem understanding it. Still if you do then lemme know...

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'
' This code uses Late Binding to connect to word and hence you '
' you don't need to add any references to it                   '
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~'

Option Explicit

'~~> Defining Word Constants
Const wdFindContinue As Long = 1
Const wdReplaceAll As Long = 2

Sub Sample()
    Dim oWordApp As Object, oWordDoc As Object, rngStory as Object
    Dim sFolder As String, strFilePattern As String
    Dim strFileName As String, sFileName As String

    '~~> Change this to the folder which has the files
    sFolder = "C:\Temp\"
    '~~> This is the extention you want to go in for
    strFilePattern = "*.docx"

    '~~> Establish an Word application object
    On Error Resume Next
    Set oWordApp = GetObject(, "Word.Application")

    If Err.Number <> 0 Then
        Set oWordApp = CreateObject("Word.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oWordApp.Visible = True

    '~~> Loop through the folder to get the word files
    strFileName = Dir$(sFolder & strFilePattern)
    Do Until strFileName = ""
        sFileName = sFolder & strFileName

        '~~> Open the word doc
        Set oWordDoc = oWordApp.Documents.Open(sFileName)

        '~~> Do Find and Replace
        For Each rngStory In oWordDoc.StoryRanges
            With rngStory.Find
                .Text = "Text to find to replace goes here"
                .Replacement.Text = "And the replacement text goes here"
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
        Next

        '~~> Close the file after saving
        oWordDoc.Close SaveChanges:=True

        '~~> Find next file
        strFileName = Dir$()
    Loop

    '~~> Quit and clean up
    oWordApp.Quit

    Set oWordDoc = Nothing
    Set oWordApp = Nothing
End Sub

Upvotes: 5

Related Questions