Hallo Liebes Forum,

das hier ist der Code um den es geht:

Sub Logo()
Dim Verz As String
Dim aDok As String
Titel = "Bitte Verzeichnis wählen"
Basis = Dialogs(wdDialogToolsOptionsFileLocations).Setting
If Not Right(Basis, 1) = "\" Then Basis = Basis & "\"
  retcode = OrdnerAuswaehlen(Titel, Basis, Verz) 'Auswählen des Ordners mit den Dateien
    If retcode = 4 Then MsgBox "Vorgang abgebrochen", vbExclamation
    If retcode = 0 Then
        ChDir Verz
        aDok = Dir(Verz & "\*.docx")
        If aDok <> "" Then
            Logo_einfuegen Verz, aDok
        End If
    Do While (aDok <> "")
        aDok = Dir()
        If aDok <> "" Then
            WordBasic.DisableAutoMacros 1
            Logo_einfuegen Verz, aDok
        End If
    Loop
    End If
WordBasic.DisableAutoMacros 0
End Sub


Private Function OrdnerAuswaehlen(ByVal Titel As String, ByVal Basis As String, _
                                  Verz As String) As Long
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = Titel
    .InitialFileName = Basis
    '.ButtonName = "Ok"
    If .Show = -1 Then
      Verz = .SelectedItems(1)
      If Right(Verz, 1) = "\" Then Verz = Left(Verz, Len(Verz) - 1) 'Normalisieren
    Else
      OrdnerAuswaehlen = 4
    End If
  End With
End Function


Private Sub Logo_einfuegen(Verz As String, aDok As String)
Documents.Open FileName:=aDok
LogoBO = ThisDocument.Path & "\Logo_BochumMVZ_18.jpg"
  
'MVZ Labor Bochum MLB GmbH löschen'
    With Selection.Find
        .ClearFormatting
        .Text = "MVZ Labor Bochum MLB GmbH"
        .Replacement.ClearFormatting
        .Replacement.Text = ""
        .Execute Replace:=wdReplaceAll, Forward:=True, _
        Wrap:=wdFindContinue
    End With


    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "MVZ Labor Bochum MLB GmbH"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    
    ActiveDocument.InlineShapes.AddPicture FileName:=LogoBO, LinkToFile:=False, SaveWithDocument:=True
    
    With ActiveDocument.InlineShapes(1)
        .ScaleHeight = 50
        .ScaleWidth = 50
    End With
    
   ActiveDocument.Save
   ActiveWindow.Close
    
        
   
    
                
End Sub

Dieser soll in den Dokumenten, die sich im angewählten Ordner befinden, mit einer Schleife durch gehen, nach einer bestimmten Zeichenkette suchen, diese löschen und durch das Logo im angegebenen Pfad ersetzen. Das klappt auch soweit alles hervorragend. Nur das abspeichern und schließen der Dokumente mag nicht funktionieren. Sobald das Makro mit der ersten Datei fertig ist kommt der Laufzeitfehler 5174 "Diese Datei wurde nicht gefunden. (Pfad zur nächsten Datei im Ordner)". Wenn ich das Speichern und Schließen weg lasse, funktioniert alles, nur muss ich dann natürlich jedes Dokument einzeln per Hand abspeichern und schließen, was ich mir gerne ersparen würde ;-)

Ich wette, ich habe da sicherlich nur irgendwo einen kleinen Denkfehler, auf den ich um's verrecken nicht komme. Ich hoffe, dass einer von euch mir da weiter helfen kann. Dankeschön!