Mehrere Textdateien aus einem Ordner automatisch einlesen

  • Excel

Es gibt 2 Antworten in diesem Thema. Der letzte Beitrag () ist von peterfido.

    Mehrere Textdateien aus einem Ordner automatisch einlesen

    Hey Freunde! :)

    Ich habe in den letzten Wochen mal angefangen VBA zu programmieren und bin richtig begeistert!
    Nun habe ich jedoch ein Problem und komme gerade nicht weiter.

    Ziel: In einem Ordner sind mehrere Textdateien, die Anzahl kann unterschiedlich sein. Ich will nun alle Textdateien automatisch nacheinander einlesen und auf wichtige Elemente durchsuchen.
    Das Auslesen einer Textdatei und filtern nach den Elementen habe ich bereits realisiert. Nun will ich das Programm aber so erweitern, dass wirklich alle vorhandenen Textdateien im Ordner automatisch nach der Reihe gelesen werden.

    Ich stehe momentan ziemlich aufm Schlauch und vielleicht könnt ihr ja mal etwas weiterhelfen :)

    Mein bisheriger Code, der eine Textdatei einlesen kann und nach den angegeben Begriffe filter werde ich hier unten anheften. ;)

    Vielen Danlk Leute! Ich freue mich auf Antworten und Hinweise :)

    Visual Basic-Quellcode

    1. Sub Text_dateien_einlesen()
    3. Dim ws As Excel.Worksheet
    5. Const szSuch = "SELFDIAGNOSIS.CODE" ' Suche nach Hex-Code
    6. Const szSuch2 = "SELFDIAGNOSIS.VEHICLE_ID" 'Suche nach Faherzeugnummer
    7. Const szSuch3 = "SELFDIAGNOSIS.STATE" 'Status Diagnose
    8. Const szSuch4 = "irgendwas"
    9. Dim i As Integer ' Zählvariable für Hex-Code
    10. Dim j As Integer 'Zählvariable für Fahrzeugnummer
    11. Dim x As Integer 'Zählvariable für Status
    13. Set objFSO = CreateObject("Scripting.FileSystemObject")
    14. Set objSourceFile = objFSO.OpenTextFile("D:\Users\name\Documents\03_Visual_Basic_Programmierung\logs.txt", 1) ' Quelldatei öffnen
    15. Set ws = ActiveWorkbook.Sheets(1) ' Zieldatei anlegen / überschreiben
    17. i = 1
    18. j = 1
    19. x = 1
    20. Do Until objSourceFile.AtEndOfStream ' Gesammtes TextDok durchgehen
    21. szNextLine = objSourceFile.Readline ' Zeile aus Quelldatei einlesen
    23. If InStr(szNextLine, szSuch) Then
    24. ws.Cells(i, 1).Value = szNextLine 'Wert in Zelle schreiben
    25. i = i + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    27. ElseIf InStr(szNextLine, szSuch2) Then
    28. ws.Cells(j, 4).Value = szNextLine 'Wert in Zelle schreiben
    29. j = j + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    31. ElseIf InStr(szNextLine, szSuch3) Then
    32. ws.Cells(x, 7).Value = szNextLine 'Wert in Zelle schreiben
    33. x = x + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    34. End If
    35. Loop
    36. End Sub

    Hi und Willkommen.

    Zum Durchsuchen benötigst du ja alle Dateien mit der Endung .TXT

    Die performante Variante (aber nicht so schön lesbar wäre):

    Visual Basic-Quellcode

    1. Const strPattern As String = "*.TXT"
    2. Dim strFolder As String
    3. strFolder = "D:\"
    4. Dim strFile As String
    5. strFile = Dir(strFolder & strPattern, vbNormal)
    6. Do While Len(strFile) > 0
    7. Debug.Print strFolder & strFile 'Datei name
    8. 'Hier mach was mit der Datei
    10. strFile = Dir
    11. Loop


    Es geht aber auch mit dem von dir schon verwendetem FileSystemobject

    Visual Basic-Quellcode

    1. Dim strFolder As String
    2. strFolder = "D:\"
    3. With objFSO.GetFolder(strFolder )
    4. For Each fil In .Files
    5. If LCase(Right(fil.Name, 4)) = ".txt" Then
    6. 'Mach was mit der Datei
    7. End If
    8. Next


    Dies ist allerdings alles ohne Einbeziehung von Unterordnern

    LG
    Das ist meine Signatur und sie wird wunderbar sein!

    Hallo,

    mit Unterordner ist das mein Vorschlag:

    Visual Basic-Quellcode

    1. Option Explicit
    3. Private Sub Test()
    4. Textdateien_Suchen "f:\", True
    6. End Sub
    8. Private Sub Textdateien_Suchen(ByVal sPfad As String, Optional ByVal Unterordner As Boolean = False)
    9. Dim oFSO As Object
    10. Dim oFLD As Folder
    11. Dim Ordner As Folder
    12. Dim Datei As File
    14. On Error Resume Next 'Fehlende Zugriffsrechte ignorieren
    15. Set oFSO = CreateObject("Scripting.FileSystemObject")
    16. If oFSO.folderexists(sPfad) Then
    17. Set oFLD = oFSO.GetFolder(sPfad)
    18. If Unterordner Then
    19. For Each Ordner In oFLD.SubFolders
    20. Textdateien_Suchen Ordner.Path, True
    21. Next
    22. End If
    23. For Each Datei In oFLD.Files
    24. If LCase(oFSO.GetExtensionName(Datei.Path)) = "txt" Then
    25. Textdatei_einlesen Datei.Path
    26. End If
    27. Next
    28. End If
    29. Set oFSO = Nothing
    30. On Error GoTo 0
    32. End Sub
    34. Private Sub Textdatei_einlesen(ByVal sDateiname As String)
    35. Debug.Print sDateiname
    36. DoEvents
    37. End Sub

    Gruß
    Peterfido

    Keine Unterstützung per PN!

Facebook
Telefonspende