Suchen und Ersetzen in Worddateien?

Forumthread: Suchen und Ersetzen in Worddateien?

09.12.2020 23:57:57

Selma

Hallo zusammen,
evtl. ist meine Frage hier im Forum verkehrt, da es um Suchen und Ersetzen für Worddateien geht. :-)
Dieses Makro funktioniert perfekt für DOC-Dateien in einem Verzeichnis. Was muss ich bitte ändern, damit die Unterverzeichnisse berücksichtigt werden?

Option Explicit
Dim dokuname As String
Dim suchwort As String, ersatzwort As String
Sub START()
Dim fso As Object, Ordner As Object, datei As Object
Dim startOrdner As String
Dim endung As String
startOrdner = InputBox("Bitte vollständigen Pfad von DOC-Dateien eingeben. Bitte am Ende ein  _
Backslah")
startOrdner = "" & startOrdner & ""
suchwort = InputBox("Bitte den zu ersetzenden Begriff eingeben")
ersatzwort = InputBox("Und jetzt das Ersatzwort!")
If startOrdner = "" Or suchwort = "" Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
Set Ordner = fso.GetFolder(startOrdner)
For Each datei In Ordner.Files
endung = fso.GetExtensionName(datei)
If endung Like "doc" Then
dokuname = startOrdner & fso.GetFileName(datei)
Debug.Print dokuname
'                SuchUndErsetz
End If
Next datei
End Sub
Sub SuchUndErsetz()
Dim doku As Document
Dim oStory As Range
Set doku = Documents.Open(dokuname)
For Each oStory In doku.StoryRanges
With oStory.Find
.Text = suchwort
.Replacement.Text = ersatzwort
.Execute Replace:=wdReplaceAll
End With
Next oStory
doku.Close savechanges:=True
End Sub

Beste Grüße,
Selma

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Suchen und Ersetzen in Worddateien?

10.12.2020 01:57:30

onur
AW: Suchen und Ersetzen in Worddateien?

10.12.2020 09:54:10

Selma

AW: Suchen und Ersetzen in Worddateien?

10.12.2020 01:57:30

onur


Dim fso, oFolder, oSubfolder, oFile, queue As Collection
If startOrdner = "" Or suchwort = "" Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(startOrdner)
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
For Each oFile In oFolder.Files
Debug.Print oFile
'Hier dein Code zum Öffnen und Ersetzen
Next oFile
Loop
...

AW: Suchen und Ersetzen in Worddateien?

10.12.2020 09:54:10

Selma

Guten Morgen Onur,
ich habe versuch wie folgt dir zu folgen :-)
Leider habe ich es nicht geschafft als Gesamtlösung zu integrieren:

Option Explicit
Dim dokuname As String
Dim suchwort As String, ersatzwort As String
Sub START2()
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim startOrdner As String
startOrdner = InputBox("Bitte vollständigen Pfad von DOC-Dateien eingeben. Bitte am Ende ein  _
Backslash", "Pfad eingeben", "P:\Daten\")
startOrdner = "" & startOrdner & ""
suchwort = InputBox("Bitte den zu ersetzenden Begriff eingeben", , "Mein text")
ersatzwort = InputBox("Und jetzt das Ersatzwort!", , "Selma")
If startOrdner = "" Or suchwort = "" Then Exit Sub
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(startOrdner)
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
queue.Add oSubfolder
Next oSubfolder
For Each oFile In oFolder.Files
Debug.Print oFile
Dim doku As Document
Dim oStory As Range
Set doku = Documents.Open(oFile)
For Each oStory In doku.StoryRanges
With oStory.Find
.Text = suchwort
.Replacement.Text = ersatzwort
.Execute Replace:=wdReplaceAll
End With
Next oStory
doku.Close SaveChanges:=True
Next oFile
Loop
End Sub

Ich habe im Internet recherchiert und ein weiteres Beispiel gefunden. In der Routine fehlt mir der Teil "SuchenErsetzenSchleife":

' **** Anpassbare Werte ****
Private Const Verzeichnis = "C:\Pfad..."
Private Const Filter = "*.doc"
Private Const UnterverzeichnisseDurchsuchen = 1
Private Const Suche = "Bankverbindung alt"
Private Const ErsetzeMit = "Bankverbindung neu"
' **** Ende der Anpassung ****
Private Teil As Range
Sub SuchenErsetzenGanzesVerzeichnis()
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
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.ProtectionType = wdNoProtection Then
If oDoc.ReadOnly = False Then
StatusBar = "Durchsuche Dokument " + aDok + "."
DoEvents
SuchenErsetzenSchleife
oDoc.Close SaveChanges:=wdSaveChanges
Else
oDoc.Close SaveChanges:=wdDoNotSaveChanges
End If
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

Beste Grüße,
Selma

Beliebteste Forumthreads (12 Monate)

Suchen und Ersetzen in Worddateien?

Forumthread: Suchen und Ersetzen in Worddateien?

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread