Option Explicit

Public Sub BatchReplaceAll()

Dim FirstLoop As Boolean
Dim myFile As String
Dim PathToUse As String
Dim myDoc As Document
Dim Response As Long
Dim myStoryRange As Range

PathToUse = "C:\Test\"

'Error handler to handle error generated whenever
'the FindReplace dialog is closed

On Error Resume Next

'Close all open documents before beginning

Documents.Close SaveChanges:=wdPromptToSaveChanges

'Boolean expression to test whether first loop
'This is used so that the FindReplace dialog will
'only be displayed for the first document

FirstLoop = True

'Set the directory and type of file to batch process

myFile = Dir$(PathToUse & "*.doc")

While myFile <> ""

    'Open document
    Set myDoc = Documents.Open(PathToUse & myFile)

    If FirstLoop Then

        'Display dialog on first loop only

        Dialogs(wdDialogEditReplace).Show

        FirstLoop = False

        Response = MsgBox("Do you want to process the rest of the files in this folder", vbYesNo)
        If Response = vbNo Then Exit Sub

    Else

        'On subsequent loops (files), a ReplaceAll is
        'executed with the original settings and without
        'displaying the dialog box again
For Each myStoryRange In ActiveDocument.StoryRanges
   If myStoryRange.StoryType <> wdMainTextStory Then
        With Dialogs(wdDialogEditReplace)
            .ReplaceAll = 1
            .Execute
        End With
    
       Do While Not (myStoryRange.NextStoryRange Is Nothing)
         Set myStoryRange = myStoryRange.NextStoryRange
          With Dialogs(wdDialogEditReplace)
            .ReplaceAll = 1
            .Execute
            End With
        Loop
    End If
Next myStoryRange

    End If

    'Close the modified document after saving changes

    myDoc.Close SaveChanges:=wdSaveChanges

    'Next file in folder

    myFile = Dir$()

Wend

End Sub