Excel-VBA-Makros, Suchen und Ersetzen von text in Word-Dokumenten, die mit einem Ausgabe-text-Datei

Habe ich erworben dies sehr handliches Stück code, dass über eine excel-Schaltfläche durchsucht einen Ordner und führt eine Suche durch und ersetzen Sie auf alle word-Dokumente, je nach Kriterien, die Eingabe in Spalte A und B ein Excel-Arbeitsblatt, es bietet auch eine msgbox zu zeigen, wie viele Dateien gefunden wurden und Ersatz loops gemacht wurden. Dieser code öffnet jedes word-Dokument im Gegenzug tut der suchen-und-ersetzen, dann spart das neue Dokument. Es gibt auch eine text-Datei um zu berichten, was sich geändert hat und wo. ABER!

Meine Frage ist zu tun mit, dass die Berichterstattung txt-Datei, derzeit denke ich ist es eingerichtet (code, genannt 'whatchanged') zu schreiben, eine Linie jedes mal, wenn es durchläuft der Reihe 'Geschichten', die innerhalb der word-Dokumente ist es daher schreiben doppelte Linien auf der report-Datei für jede Geschichte sucht er durch, anstatt nur eine Zeile für was hat sich eigentlich schon gefunden und ersetzt.

Ich bin kämpfen, um eine Weise zu denken, damit dieser code-Ausgabe nur eine Zeile, um zu zeigen, was sich verändert hat, ohne Duplikate. Es scheint auch die Ausgabe einer Zeile auf den text-Datei, selbst wenn Sie keine finden und zu ersetzen, wurde für jeden Bereich Geschichte! also nicht sehr hilfreich...

Ich wäre wirklich dankbar wenn jemand könnte vielleicht empfehlen, eine gute Möglichkeit, um die Berichterstattung text-Datei aufgeräumter? - ich.e nur die Berichterstattung über das eigentliche suchen und ersetzen gemacht, mit keine doppelten Linien.

Jede Hilfe /Anregungen Sie geben könnten, werden sehr geschätzt werden, beachten Sie, dass ich bin neu in diesem forum und vba, so versuche ich mein bestes, um von anderen zu lernen und Forschung-code, wie ich gehe. Ich habe auch gepostet, in der Hoffnung, dieser code kann hilfreich sein, um andere zu, wenn Ihr auf der Suche nach etwas ähnliches.

btw.. Hier ein Beispiel der Textdatei-Ausgabe für nur ein Dokument testen!, sorry wenn das nicht ganz klar... das erstellt wurde, nachdem die Ausführung des Codes mit ein paar Tests zu finden und ersetzt die Eintragung in die excel-Tabelle - können Sie sehen, was ich meine, über die Vervielfältigung:

Datei, Finden, Austausch, Zeit

H:\Letters Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:02

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:03

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:04

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:05

H:\Briefe Test\Doc1.doc|Test-text im Brief|ersetzen von text|15/10/2013 11:06:05

H:\Briefe Test\Doc1.doc|Oktober|November|15/10/2013 11:06:05

H:\Briefe Test\Doc1.doc|Mr VBA-Tester|Ms Testen|15/10/2013 11:06:05

H:\Briefe Test\Doc1.doc|2013|2014|15/10/2013 11:06:05

H:\Briefe Test\Doc1.doc|mit freundlichen GRÜßEN|Hochachtungsvoll|15/10/2013 11:06:05

Code:

'~~> Defining Word Constants
Const wdFindContinue As Long = 1
Const wdReplaceAll As Long = 2

Public FileNum As Integer
Public OutputTxt As String


Sub WordReplace(sFolder, savePath)
Dim oWordApp As Object, oWordDoc As Object, rngStory As Object
Dim strFilePattern As String
Dim strFileName As String, sFileName As String
Dim rngXL As Range
Dim x As Range
Dim strFind As String
Dim strReplace As String
Dim whatChanged As String

'~~> This is the extention you want to go in for
strFilePattern = "*.do*"

'~~> Establish an Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

'~~> Loop through the folder to get the word files

strFileName = Dir$(sFolder & "\" & strFilePattern)


whatChanged = "File, Find, Replacement, Time" & vbCrLf
Print #FileNum, whatChanged

Dim i, j
    i = 0 ' count of files found
    j = 0 ' count of files that matched

Do Until strFileName = ""

    i = i + 1

    sFileName = sFolder & "\" & strFileName

    '~~> Open the word doc
    Set oWordDoc = oWordApp.Documents.Open(sFileName)
    Set rngXL = Sheets(1).Range("A2:A" & Range("A2").End(xlDown).Row)

    '~~> Do Find and Replace
    For Each rngStory In oWordDoc.StoryRanges

        For Each x In rngXL
            strFind = x.Value
            strReplace = x.Offset(0, 1).Value
            j = j + 1
            With rngStory.Find
                .text = strFind
                .Replacement.text = strReplace
                .Wrap = wdFindContinue
                .Execute Replace:=wdReplaceAll
            End With
           whatChanged = sFileName & "|" & strFind & "|" & strReplace & "|" & Now()
           Print #FileNum, whatChanged
        Next

    Next

    '~~> Close the file after saving
    oWordDoc.Close SaveChanges:=True

    '~~> Find next file
    strFileName = Dir$()
Loop

'Call writeToFile(whatChanged, savePath)

MsgBox ("Found " & i & " files and " & j & " replacements made")

'~~> Quit and clean up
oWordApp.Quit

Set oWordDoc = Nothing
Set oWordApp = Nothing

End Sub

Sub writeToFile(text, path)
Set objFso = CreateObject("Scripting.FileSystemObject")

Dim objTextStream
Set objTextStream = objFso.OpenTextFile(path, 8, True)

'Display the contents of the text file
objTextStream.WriteLine text

'Close the file and clean up
objTextStream.Close
Set objTextStream = Nothing
Set objFso = Nothing
End Sub


Private Sub Button1_Click()
Dim objFileClass As FileClass
Set objFileClass = New FileClass

Dim searchPath, savePath
searchPath = objFileClass.SelectFolder

FileNum = FreeFile

OutputTxt = searchPath & "\FindAndReplaceAuditFile.TXT"

Open OutputTxt For Output As FileNum

Call WordReplace(searchPath, savePath)

Close #FileNum

End Sub
InformationsquelleAutor Alex H | 2013-10-16
  1. 0

    Den Finden.Ausführen Methode liefert den boolean auf Erfolg. Schreiben Sie eine log-Zeile wird nur nach erfolgreicher Austausch:

    With rngStory.Find
  .text = strFind
  .Replacement.text = strReplace
  .Wrap = wdFindContinue
  If .Execute(Replace:=wdReplaceAll) Then
    whatChanged = sFileName & "|" & strFind & "|" & strReplace & "|" & Now()
    Print #FileNum, whatChanged
  End If
End With
    • Danke Roman, ich habe diese Methode einen Versuch und bekam einen compile-Fehler, ungültige / nicht qualifizierte Referenz .ausführen .
    • .Ausführen müssen, werden in Mit - block, es könnte sein das der Fehler. Ich habe bearbeitet code-fragment.
    • vielen Dank, ja das war, was das problem verursacht... habe ich geändert, der code, das makro erneut auszuführen und der daraus resultierende text-Datei sieht viel besser aus ! danke.
    InformationsquelleAutor Roman Plischke
  2. 0

    Sehe ich zwei Optionen:

    1) Sie schreiben eine Bedingung, bevor der string geschrieben wird an die Datei;

    2) führen Sie einige VBA auf die Datei zu filtern, doppelte strings.

    Unter Berücksichtigung der ersten option, es gibt ein paar Möglichkeiten, die Sie gehen können:

    1) Lesen Sie die Datei, und vergleichen Sie die neue Zeichenfolge an, was bereits in der Datei: dies würde aber sehr lange dauern;

    2) Speichern des vorherigen strings in ein array und prüfen, ob der neue string ist bereits im array: diese werden schneller, da der Prozess findet im Speicher;

    3) Persönlich würde ich mit einem Wörterbuch, wenn die Länge der Zeichenkette ist akzeptabel. Ein Wörterbuch hat eine Struktur, wo Sie können speichern Schlüssel - Wert-paar-Datensätze.

    Das Wörterbuch hat eine typische Exists Methode, die prüft, ob ein bestimmter Schlüssel existiert bereits in der Struktur. Ich glaube nicht, dass dieser Schlüssel erlaubt Räume, aber Sie können ersetzen Sie diese Leerstellen durch Unterstriche.

    In diesem Fall würden Sie speichern jede Suche string, wie ein Schlüssel im dictionary, unter der Bedingung, dass der Schlüssel (den Suchbegriff) noch nicht vorhanden ist.

    Die Struktur eines Wörterbuchs: 

    Dim dict As New Scripting.Dictionary 
dim sFind_value as string
dim sKey as string    
dim sValue as string

sFind_value = trim("whatever value")
sKey = replace(sFind_value, " ", "_")
sValue = "whatever"

If Not dict.Exists(sKey) Then 
    dict.Add sKey, sValue
    'Write to file
End If

    Lassen Sie mich wissen, wenn dies hilfreich, oder wenn Sie brauchen mehr Hilfe zu dem Thema.

    • Dank sehr viel für Kim, ich haben, denken Sie an diese Möglichkeiten!
    InformationsquelleAutor Trace
Schreibe einen Kommentar