Vba code is opening the word documents but it is not executing the Find-Replace function. Need some editing

Question

Sub FindandReplace()
Dim wrd As Word.Application
Set wrd = CreateObject("word.application")
wrd.Visible = True
AppActivate wrd.Name
FName = Dir("C:\Users\user\Desktop\folderb\*.doc")
Do While (FName <> "")
    With wrd
        .Documents.Open ("C:\Users\user\Desktop\folderb\" & FName)
        If .ActiveWindow.View.SplitSpecial = wdPaneNone Then
            .ActiveWindow.ActivePane.View.Type = wdPrintView
        Else
            .ActiveWindow.View.Type = wdPrintView
        End If

        With Selection.Find
        .Text = "Day 10"
        .Replacement.Text = "Day 11"
        .Execute Replace:=wdReplaceAll, Forward:=True, _
         Wrap:=wdFindContinue
        End With

       With Selection.Find
       .Text = "delta"
       .Replacement.Text = "alpha"
       .Execute Replace:=wdReplaceAll, Forward:=True, _
       Wrap:=wdFindContinue
       End With

       With Selection.Find
       .Text = "5.4.1"
       .Replacement.Text = "5.6.0"
       .Execute Replace:=wdReplaceAll, Forward:=True, _
       Wrap:=wdFindContinue
       End With
      .ActiveDocument.Save
      .ActiveDocument.Close
    End With
    FName = Dir
    Loop
    Set wrd = Nothing
  End Sub

I am trying to find and replace texts in ten different word documents contained in "folderb"

But the problem is once i run this macro the documents open one by one, gets saved and exit.

The find and replace job is not being done!

Please tell me where have i gone wrong in the above code.

Any help would be sincerely appreciated.

Answer 1

Tried and tested

Sub LoopDirectory()
    Dim vDirectory As String
    Dim oDoc As Document
    vDirectory = "D:\test\"
    vFile = Dir(vDirectory & "*.docx")

    Do While vFile <> ""
        Set oDoc = Documents.Open(FileName:=vDirectory & vFile)
         With oDoc.Range.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchWildcards = False
            .Text = "Day 10"
            .Replacement.Text = "Day 11"
            .Execute Replace:=wdReplaceAll
            .Text = "delta"
            .Replacement.Text = "alpha"
            .Execute Replace:=wdReplaceAll
            .Text = "5.4.1"
            .Replacement.Text = "5.6.0"
            .Execute Replace:=wdReplaceAll
        End With
        oDoc.Close SaveChanges:=True
        vFile = Dir
    Loop
End Sub

Answer 2

I think that you are basically missing the part where you need to select all the text before you can replace content. So after opening up the file before the first selection.find you need to select all the text in that document. In your case it would be

    .Documents.Open ("C:\Users\user\Desktop\folderb\" & FName)
    If .ActiveWindow.View.SplitSpecial = wdPaneNone Then
        .ActiveWindow.ActivePane.View.Type = wdPrintView
    Else
        .ActiveWindow.View.Type = wdPrintView
    End If

    ActiveDocument.Range(0, 0).Select
    Selection.WholeStory

    With Selection.Find
    .Text = "Day 10"
    .Replacement.Text = "Day 11"
    .Execute Replace:=wdReplaceAll, Forward:=True, _
     Wrap:=wdFindContinue
    End With