Folgenden Code in ein neues Modul.

Achtung: 

Die Pfadangaben müssen stimmen.

Entweder in Spalte A, jede Zelle mit nem \ abschließen

Oder in Spalte B, jede Zelle mit \ beginnen.

Selbsterklärend eigentlich...

Option Explicit
Const wdReplaceAll As Long = 2
Const wdFindContinue As Long = 1

Sub modifiedDOCXAendern()

    Dim dStart As Date
    Dim lngZeileDatei As Long, lngLastDatei As Long
    Dim appWord As Object
    Dim wdDatei As Object
    Dim fso As Object
    Dim wks As Worksheet
    '
    On Error GoTo FinishErr:
    
    Application.ScreenUpdating = False
     
    dStart = Time
    '#########################################
    'Achtung: ggf Exit Sub
    '#########################################
    If bcheckWorksheet("Dateien") = False Then
        MsgBox "Worksheet Dateien nicht gefunden. Aktion abgebrochen.", vbCritical + vbOKOnly, "Autor informiert": Exit Sub
    Else
        Set wks = ThisWorkbook.Worksheets("Dateien")
    End If
    'letztes beschriebene Zelle in Spalte A finden
    With wks
        lngLastDatei = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    'Create WordInstanz
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = True
    '
    For lngZeileDatei = 2 To lngLastDatei
        
        If CreateObject("Scripting.FileSystemObject").FileExists(wks.Range("A" & lngZeileDatei) & Range("B" & lngZeileDatei)) = True Then
            Set wdDatei = appWord.Documents.Open(Range("A" & lngZeileDatei) & Range("B" & lngZeileDatei))
        
             With appWord.Selection.Find
               .Text = "Wein"
               .Replacement.Text = "Wein1"
               .Forward = True
               .Wrap = wdFindContinue
             End With
             
            appWord.Selection.Find.Execute Replace:=wdReplaceAll
            appWord.ActiveDocument.Close savechanges:=True
        End If
        
    Next lngZeileDatei
     
    appWord.Application.Quit
    'Messwerte ausgeben
    dStart = Time - dStart
    MsgBox "Laufzeit " & dStart & ", Geändert: " & lngLastDatei - 1
    'Range("A1").Select
    Application.Goto Reference:=wks.Range("A1")
     

FinishErr:
'
If Err.Number <> 0 Then
  MsgBox Err.Number & vbCrLf & Err.Description
End If
'
Set wdDatei = Nothing
Set appWord = Nothing
Application.ScreenUpdating = True
End Sub

Function bcheckWorksheet(sWks As String) As Boolean
    Dim wks As Worksheet
    On Error GoTo FinishErr:
    '
    Set wks = ThisWorkbook.Worksheets(sWks)
    '
FinishErr:
Select Case Err.Number
    Case 0: bcheckWorksheet = True
    Case 9: bcheckWorksheet = False
    Case Else: bcheckWorksheet = False
End Select
End Function