RTF Dokumente durchsuchen und in Excel einfügen (Quellcode teilweise vorhanden)
Hallo liebe Community,
ich bin neu hier und hoffe hier Hilfe zu finden Ich habe im Office Forum einen sehr netten und guten Member kennengelernt, der mit mir ein VBA Skript erstellt hat. Dieses soll mehrere Dokumente auf ein bestimmten begriff durchsuchen, und zwar sollen alle wörter die mit $$T_Fix und mit # enden kopiert werden. Das Skript öffnet in Excel ein Fenster, womit ich mehrere Dokumente auswählen kann. Überall wo der Begriff auftaucht, wird dies in einer Zeile in Excel eingefügt. Es Funktioniert auch Prima. Mein einziges Problem ist, dass ich das nicht nur für doc Dokumente brauche, sondern auch für Rich Text files (rtf). Hier der Quellcode:
Sub findeFix1()
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim objWord As Object
Dim objDialogOpen As Object
Dim ranG As Range
Dim DateiAuswaehlen As Variant
Dim objFiledialog As FileDialog
Dim rngZeiler As Range, leer As Boolean, kn As Long
Dim rngwdoc As Word.Range
Dim strFile As String
ThisWorkbook.Worksheets("AufnahmeTab").Activate
Set appWord = CreateObject("Word.Application")
Set objFiledialog = Application.FileDialog(msoFileDialogFilePicker)
With objFiledialog
.AllowMultiSelect = True
If .Show = True Then
For Each DateiAuswaehlen In .SelectedItems
Set docWord = GetObject(DateiAuswaehlen)
docWord.Range.Find.ClearFormatting
Set rngwdoc = docWord.Range
With rngwdoc.Find
.Text = "$$T_FIX*#"
.Replacement.Text = ""
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Do
rngwdoc.Find.Execute
oli = rngwdoc.Find.Found
Debug.Print rngwdoc
If oli = True Then
Set ranG = Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
ranG = rngwdoc
End If
Loop Until oli = False
Set docWord = Nothing
Next DateiAuswaehlen
End If
End With
Set objFiledialog = Nothing
Range("I:O").Columns.AutoFit
Set objDialogOpen = Nothing
Set docWord = Nothing
appWord.Quit False
Set appWord = Nothing
End Sub
Ich habe keine Ahnung wie ich die RTF machen soll, da wir größtenteils mit der Microsoft Word-Objekt gearbeitet haben. Kann mir da jemand weiterhelfen?
LG
ich bin neu hier und hoffe hier Hilfe zu finden Ich habe im Office Forum einen sehr netten und guten Member kennengelernt, der mit mir ein VBA Skript erstellt hat. Dieses soll mehrere Dokumente auf ein bestimmten begriff durchsuchen, und zwar sollen alle wörter die mit $$T_Fix und mit # enden kopiert werden. Das Skript öffnet in Excel ein Fenster, womit ich mehrere Dokumente auswählen kann. Überall wo der Begriff auftaucht, wird dies in einer Zeile in Excel eingefügt. Es Funktioniert auch Prima. Mein einziges Problem ist, dass ich das nicht nur für doc Dokumente brauche, sondern auch für Rich Text files (rtf). Hier der Quellcode:
Sub findeFix1()
Dim appWord As Word.Application
Dim docWord As Word.Document
Dim objWord As Object
Dim objDialogOpen As Object
Dim ranG As Range
Dim DateiAuswaehlen As Variant
Dim objFiledialog As FileDialog
Dim rngZeiler As Range, leer As Boolean, kn As Long
Dim rngwdoc As Word.Range
Dim strFile As String
ThisWorkbook.Worksheets("AufnahmeTab").Activate
Set appWord = CreateObject("Word.Application")
Set objFiledialog = Application.FileDialog(msoFileDialogFilePicker)
With objFiledialog
.AllowMultiSelect = True
If .Show = True Then
For Each DateiAuswaehlen In .SelectedItems
Set docWord = GetObject(DateiAuswaehlen)
docWord.Range.Find.ClearFormatting
Set rngwdoc = docWord.Range
With rngwdoc.Find
.Text = "$$T_FIX*#"
.Replacement.Text = ""
.Forward = True
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Do
rngwdoc.Find.Execute
oli = rngwdoc.Find.Found
Debug.Print rngwdoc
If oli = True Then
Set ranG = Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1)
ranG = rngwdoc
End If
Loop Until oli = False
Set docWord = Nothing
Next DateiAuswaehlen
End If
End With
Set objFiledialog = Nothing
Range("I:O").Columns.AutoFit
Set objDialogOpen = Nothing
Set docWord = Nothing
appWord.Quit False
Set appWord = Nothing
End Sub
Ich habe keine Ahnung wie ich die RTF machen soll, da wir größtenteils mit der Microsoft Word-Objekt gearbeitet haben. Kann mir da jemand weiterhelfen?
LG
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-Key: 215323
Url: https://administrator.de/contentid/215323
Ausgedruckt am: 29.03.2024 um 10:03 Uhr
2 Kommentare
Neuester Kommentar
Hallo Xplosio!
schau mal dahin, vieleicht hilft dir das weiter:
http://www.herber.de/forum/archiv/764to768/t764400.htm
... ansonsten könntest du die RTF's nicht einfach als Textdateien behandeln (?) ...
Gruß
amn.ssy
schau mal dahin, vieleicht hilft dir das weiter:
http://www.herber.de/forum/archiv/764to768/t764400.htm
... ansonsten könntest du die RTF's nicht einfach als Textdateien behandeln (?) ...
Gruß
amn.ssy