Hallo Peter,
wie versprochen hier die Makros, die zusammen wirken.
bitte alles in ein Modul kopieren und die Einträge in
„Anpassbare Werte“ anpassen.
Ich habs gerade nochmal getestet, es funktioniert!
Wenn Du allerdings mit Passwort schreibgeschützte Dokumente hast
fragt das Makro natürlich nach dem Passwort. Dieses sollte man dann parat haben.
Anmerkung: Das Makro funktioniert auch in Kopf-Fußzeilen.
Viel Erfolg
Ullrich Sander
’ **** Anpassbare Werte ****
Private Const Verzeichnis = „C:\maly\md_R-n\md_R-n\Haus 12\Vorlagen\tmp“
Private Const Filter = „*.dot“
Private Const UnterverzeichnisseDurchsuchen = 1
Private Const Suche = „Ludwig Scholz“
Private Const ErsetzeMit = „Dr. Ulrich Maly“
’ **** Ende der Anpassung ****
Private Teil As Range
Sub maly()
Screenupdate = False
Dim oDoc As Document
tmp = UnterverzeichnisseDurchsuchen
If tmp = 1 Then UVD = True Else UVD = False
If Documents.Count > 0 Then Dokument = ActiveDocument.FullName
With Application.FileSearch
.LookIn = Verzeichnis
.FileName = Filter
.SearchSubFolders = UVD
.Execute SortBy:=msoSortByFileName
Anzahl = .FoundFiles.Count
Application.ScreenUpdating = False
For Each aDok In .FoundFiles
wasProtected = 0
If aDok Dokument Then
On Error Resume Next
Documents.Open aDok
Fehler = Err.Number
On Error GoTo 0
If Fehler = 0 Then
Set oDoc = ActiveDocument
If oDoc.ReadOnly = False Then
If oDoc.ProtectionType wdNoProtection Then
wasProtected = oDoc.ProtectionType
oDoc.Unprotect
End If
StatusBar = "Durchsuche Dokument " + aDok + „.“
DoEvents
SuchenErsetzenSchleife
If wasProtected wdNoProtection Then oDoc.Protect Type:=wasProtected, Noreset:=True
oDoc.Close SaveChanges:=wdSaveChanges
Else
oDoc.Close SaveChanges:=wdDoNotSaveChanges
End If
End If
End If
Next
End With
StatusBar = CStr(Anzahl) + " Dokumente durchsucht."
DoEvents
Application.ScreenUpdating = True
End Sub
Private Sub SuchenErsetzenSchleife()
Application.ScreenUpdating = False
For Each Teil In ActiveDocument.StoryRanges
SuchenErsetzen
While Not (Teil.NextStoryRange Is Nothing)
Set Teil = Teil.NextStoryRange
SuchenErsetzen
Wend
Next
End Sub
Private Sub SuchenErsetzen()
Teil.Find.Execute FindText:=Suche, _
ReplaceWith:=ErsetzeMit, _
MatchCase:=GrossUndKleinSchreibung, _
MatchWholeWord:=GanzesWort, _
MatchWildcards:=Jocker, _
Replace:=wdReplaceAll
End Sub
