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!
|