Viele Text Dateien durchsuchen

Forumthread: Viele Text Dateien durchsuchen

24.03.2021 16:32:42

stef26

Hallo Liebe Excel VBA Spezialisten,
ich hab ein Problem bei dem ich mal euren Support gut gebrauchen könnte...
Ich habe in einem Ordner tausende von Textfiles liegen.
Diese haben die Endung .qd
In jeder dieser Dateien soll nach dem Wort "BESTUECKEN" gesucht werden und die Anzahl der gefundenen Worte
in der Excelliste geschrieben werden.
So dass ich z.B. in der Spalte A den Namen der Textdatei habe und in der Spalte B dazu die Anzahl der gefundenen Worte "BESTUECKEN".
Wer wäre so lieb und könnte mir da unter die Arme greifen?
Liebe Grüße
Stefan

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Musterdatei

24.03.2021 16:33:32

UweD
AW: Musterdatei

24.03.2021 16:43:58

UweD
AW: Musterdatei

24.03.2021 16:59:05

UweD
AW: Viele Text Dateien durchsuchen

24.03.2021 17:05:52

Daniel
AW: Viele Text Dateien durchsuchen

24.03.2021 17:44:31

volti
Vielen Dank an ALLE

25.03.2021 09:56:47

stef26

Musterdatei

24.03.2021 16:33:32

UweD

AW: Musterdatei

24.03.2021 16:43:58

UweD

Hallo nochmal
Steht das Wort auch mehrmals in einer Zeile?
Oder immer nur 1. ?
LG

AW: Musterdatei

24.03.2021 16:59:05

UweD

Also, falls je Zeile nur 1x dann so


Sub Zählen_Worte()
Dim Pfad As String, Datei As String, Ext As String
Dim Suchwort As String, Anz As Integer
Dim TB As Worksheet, Sp As Integer, LR As Integer
'**** anpassen
Ext = "*.qd"
Pfad = "E:\Excel\Temp\TT\" '**** mit \
Suchwort = "BESTUECKEN"
Set TB = ThisWorkbook.Sheets("Tabelle1")
Sp = 1 ' Spalte
'**** anpassen Ende
Application.ScreenUpdating = False
'Alle Dateien finden
Datei = Dir(Pfad & Ext)
Do While Len(Datei) > 0
'Datei öffnen
Workbooks.OpenText Filename:=Pfad & Datei, _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, Semicolon:=False, Comma:=False, Space:=False, _
Other:=False, FieldInfo:=Array(1, 2), TrailingMinusNumbers:=True
'Zählen
Anz = WorksheetFunction.CountIf(ActiveSheet.Columns(1), "*" & Suchwort & "*")
'Freie Zeile
LR = TB.Cells(TB.Rows.Count, Sp).End(xlUp).Row + 1
'Daten schreiben
TB.Cells(LR, 1) = Datei
TB.Cells(LR, 2) = Anz
'Schliessen ohne Speichern
Workbooks(Datei).Close False
Datei = Dir() ' nächste Datei
Loop
End Sub

LG UweD

AW: Viele Text Dateien durchsuchen

24.03.2021 17:05:52

Daniel

Hi
probiers mal so:

Sub test()
Dim datei As String
Dim pfad As String
Dim txt As String
Dim Suchwort As String
Dim Anzahl As Long
pfad = "C:\Daten\Sonstiges\"
datei = Dir(pfad & "*.qd")
Suchwort = "BESTUECKEN"
Do While datei  ""
txt = ReadFile(pfad & datei)
Anzahl = (Len(txt) - Len(Replace(txt, Suchwort, ""))) / Len(Suchwort)
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value = Array(datei, Anzahl)
datei = Dir
Loop
End Sub
Public Function ReadFile(ByVal sFilename As String) As String
'--- Quelle: https://www.vbarchiv.net/tipps/tipp_298-textdateien-schnell-auslesen.html
Dim F As Integer
Dim sInhalt As String
F = FreeFile: Open sFilename For Binary As #F
sInhalt = Space$(LOF(F))
Get #F, , sInhalt
Close #F
End If
ReadFile = sInhalt
End Function

die Function "ReadFile" habe ich von der angegebenen Quelle übernommen.
den Pfadnamen musst du noch an deine Bedürfnisse anpassen.
Gruß Daniel

AW: Viele Text Dateien durchsuchen

24.03.2021 17:44:31

volti

Hallo,
hier noch eine Variante, die unabhängig von der Zeile alle BESTUECKEN zählt.

Code:


[Cc]

Sub Test()
  Dim iFF As Integer, sFilename As String, sArr() As String

  Const csPath = "C:&bsol;Daten&bsol;"
  sFilename = Dir$(csPath & "*.qd")
 
  Do While sFilename <> ""
     iFF = FreeFile
     Open csPath & sFilename For Input As iFF         ' Datei öffnen
     sArr = Split(Input(LOF(iFF), iFF), "BESTUECKEN") ' in Array und splitten
     Close iFF
     Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 2).Value _
           = Array(sFilename, UBound(sArr))
     sFilename = Dir$
  Loop
End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz

Vielen Dank an ALLE

25.03.2021 09:56:47

stef26

Vielen Dank für die zahlreichen Hilfestellungen.
DANKE
SUPER FORUM!!
:-)
Stefan

Beliebteste Forumthreads (12 Monate)

Forumthread: Viele Text Dateien durchsuchen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread