Alle Textdateien aus einem Ordner einlesen

  • Excel

Es gibt 12 Antworten in diesem Thema. Der letzte Beitrag () ist von Marco123.

    Alle Textdateien aus einem Ordner einlesen

    abgetrennt von Mehrere Textdateien aus einem Ordner automatisch einlesen ~VaporiZed

    Hallo Forum,

    Ich bin durch meine Internet-Recherche auf das Forum gestoßen und hab mich natürlich sofort angemeldet :)

    Das o.g. Thema scheint genau die Lösung meiner aktuellen Herausforderung zu sein, weshalb ich es trotz des Alters nochmal aufgreifen möchte.
    Ebenso wie dirkst19, dessen Code übrigens hervorragend funktioniert, würde ich gerne alle txt.Dateien innerhalb eines Ordners durchsuchen lassen.

    Mono hat ja bereits Lösungsansätze gepostet, jedoch scheitere ich daran, eine von beiden in den Code von dirkst19 zu implementieren.

    Wer könnte mir dabei helfen, beide Codes zu vereinen?
    Eine anfängergeeignete Anleitung oder gar ein fertiger Code würden mir sehr helfen.


    Ich bedanke mich schon mal im Voraus für die Unterstützung und hoffe auf eine baldiges Feedback auf meine Anfrage.

    MfG
    Marco123

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „VaporiZed“ ()

    Hallo petaod,

    vielen Dank, dass Du meine Anfrage aufgenommen hast.

    Den Code hab ich hier im Forum gefunden.
    Mein Beitrag wurde vom ursprünglichen Thema abgeschnitten.
    Ein entsprechender Link wurde dabei aber oberhalb meines Beitrags eingefügt. Dort ist der Code einzusehen.

    Alternativ:
    Mehrere Textdateien aus einem Ordner automatisch einlesen

    Ich hab den hier zur Verfügung gestellten Code "Sub Text_Dateien_einlesen()" in ein Modul eingefügt und in an meine Datei angepasst (welche TXT soll wonach durchsucht werden und wo sollen die Dateien eingefügt werden).
    Klappt auch alles hervorrangend.

    Ich kriegt es jedoch nicht hin, einen der dort vorgeschlagenen beiden Zusatz-Codes einzubinden, um nicht nur eine bestimmte sondern alle TXT innerhalb eines Ordners zu prüfen und auszulesen.

    Mehr hab ich leider nicht zustande bekommen, wobei ich erwähnen sollte, dass ich mit meinen VBA-Kenntnissen doch noch sehr am Anfang stehe.
    Guten Morgen,

    hier zur Verdeutlichung mein aktueller Code:

    Quellcode

    1. Sub Text_dateien_einlesen()
    2. Const szSuch1 = "105981" ' Suche nach Kundennummer
    3. Const szSuch2 = "AS:" 'Suche nach AS-Nummer
    4. 'Const szSuch3 = "???"
    5. Dim i As Integer 'Zählvariable
    6. Dim j As Integer 'Zählvariable
    7. Dim x As Integer 'Zählvariable
    8. Dim ws As Excel.Worksheet
    9. Set ws = ActiveWorkbook.Sheets("Daten_Rechnungen") ' Zieldatei anlegen / überschreiben
    10. Set objFSO = CreateObject("Scripting.FileSystemObject")
    11. Set objSourceFile = objFSO.OpenTextFile(Range("A1"), 1) ' Quelldatei öffnen
    12. i = 10
    13. j = 10
    14. x = 10
    15. Tabelle5.Range("A10:B500000").ClearContents 'Tabelle vorher leeren
    16. Do Until objSourceFile.AtEndOfStream ' Gesammtes TextDok durchgehen
    17. szNextLine = objSourceFile.ReadLine ' Zeile aus Quelldatei einlesen
    18. If InStr(szNextLine, szSuch1) Then
    19. ws.Cells(i, 1).Value = szNextLine 'Wert in Zelle schreiben
    20. i = i + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    21. ElseIf InStr(szNextLine, szSuch2) Then
    22. ws.Cells(j, 2).Value = szNextLine 'Wert in Zelle schreiben
    23. j = j + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    24. 'ElseIf InStr(szNextLine, szSuch3) Then
    25. 'ws.Cells(x, 3).Value = szNextLine 'Wert in Zelle schreiben
    26. 'x = x + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    27. End If
    28. Loop
    29. End Sub


    Hiermit kann aber nur eine Datei bearbeitet werden.
    Um nicht ständig die Adresse im Code selbst ändern zu müssen, hab ich es schonmal so umgestrickt, dass die Adresse aus Zelle A1 entnommen wird.

    Es ist jedoch sehr müßig, das für jede einzelne meiner TXT durchzuführen, die daten dann per Copy&Paste in die Auswerte-Tabelle zu schieben, und dann wieder von vorne anzufangen.
    Daher der Wunsch, dass der Code alles in einem Abwasch erledigt.

    Angeblich soll es laut User Mono mit folgendem Code realisierbar:

    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


    Ich hab es mehrfach probiert, diesen irgendwie in den Haupt-Code einzubinden, bin hierbei jedoch immer wieder kläglich gescheitert.
    Da keiner meiner Versuche geklappt hat, hab ich sie nicht abgespeichert, weshalb ich auch keinen dieser "Versuch-Codes" vorstellen kann.

    Visual Basic-Quellcode

    1. Option Explicit
    2. Dim FSO As Object
    3. Const RootFolderName = "D:\"
    4. Const FileNameFilter = "*.txt"
    5. Const szSuch1 = "105981" ' Suche nach Kundennummer
    6. Const szSuch2 = "AS:" 'Suche nach AS-Nummer
    7. Sub LoopFolder()
    8. Dim Folder As Object, File As Object
    9. If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    10. Set Folder = FSO.GetFolder(RootFolderName)
    11. For Each File In Folder.Files
    12. If File.Name Like FileNameFilter Then ReadTextFile File.Path
    13. Next
    14. End Sub
    15. Sub ReadTextFile(ByVal Path As String)
    16. Dim SourceFile As Object, Line As Object
    17. Dim i As Integer 'Zählvariable
    18. Dim j As Integer 'Zählvariable
    19. Dim x As Integer 'Zählvariable
    20. Dim ws As Excel.Worksheet
    21. Set ws = Sheets("Daten_Rechnungen") ' Zieldatei anlegen / überschreiben
    22. Set SourceFile = FSO.OpenTextFile(Path, 1) ' Quelldatei öffnen
    23. i = 10
    24. j = 10
    25. x = 10
    26. Intersect(ws.UsedRange, ws.Range("A10:B" & Rows.Count)).ClearContents 'Tabelle vorher leeren
    27. Do Until SourceFile.AtEndOfStream ' Gesamtes TextDok durchgehen
    28. Line = SourceFile.ReadLine ' Zeile aus Quelldatei einlesen
    29. If InStr(Line, szSuch1) Then
    30. ws.Cells(i, 1).Value = Line 'Wert in Zelle schreiben
    31. i = i + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    32. ElseIf InStr(Line, szSuch2) Then
    33. ws.Cells(j, 2).Value = Line 'Wert in Zelle schreiben
    34. j = j + 1 'Zähler für nächste Zeile erhöhen ' Zeile in Zieldatei schreiben
    35. End If
    36. Loop
    37. End Sub
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --

    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „petaod“ ()

    Hallo petaod,

    vielen Dank für die schnelle Bearbeitung.
    Hab es grade ausprobiert und es funktioniert … fast.

    Es scheinen noch 2 Steine im Weg zu liegen, wobei ich einen tatsächlich selbst wegräumen konnte.

    Folgende hab ich bisher angepasst:
    => Vorher : Dim Line as Object
    Hiermit brach der Code in Zeile 29 mit der Meldung "Laufzeitfehler '91': Objektvariable oder With-Blockvariable nicht festgelegt" ab.

    => Meine Anpassung: Dim Line as String (Zeile 17)
    Damit läuft der Code ohne Fehlermeldung durch.


    Der letzte Stein scheint etwas schwere zu sein, zumindest für mich.
    Der Code liest alles gewünschte aus allen TXT ein (was er ja auch soll), jedoch überschreibt er die Daten immer und immer wieder in dem er immer wieder in Zeile 10 mit seinen Einträgen startet.

    Ich dacht erst, es liegt evtl. am ständigen Durchlauf von Zeile 27 (ClearContens), welche ich auch probehalber entfernt hab, aber das war nicht die Lösung.

    Welcher Befehl wäre denn an welcher Stelle von Nöten bzw. was müsste angepasst / entfernt werden, um die ausgelesenen Daten untereinander zuschreiben?


    Vielen Dank schon mal im Voraus für Deine Hilfe.
    Das war ja mal eine schnelle Antwort.

    Jetzt läuft alles sauber und perfekt durch.
    Ein Traum.

    Viele, vielen Dank für Deine Hilfe.

    Und hier, falls jemand den vollständigen Code benötigt:

    Quellcode

    1. Option Explicit
    2. Dim FSO As Object
    3. Const RootFolderName = "C:\Users\van-den-heuvel\Desktop\Rechnung_Schoenmackers\2019"
    4. Const FileNameFilter = "*.txt"
    5. Const szSuch1 = "105981" ' Suche nach Kundennummer
    6. Const szSuch2 = "AS:" 'Suche nach AS-Nummer
    7. Dim i As Integer 'Z?hlvariable
    8. Dim j As Integer 'Z?hlvariable
    9. Dim x As Integer 'Z?hlvariable
    10. Sub LoopFolder()
    11. Dim Folder As Object, File As Object
    12. i = 10
    13. j = 10
    14. If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    15. Set Folder = FSO.GetFolder(RootFolderName)
    16. For Each File In Folder.Files
    17. If File.Name Like FileNameFilter Then ReadTextFile File.Path
    18. Next
    19. End Sub
    20. Sub ReadTextFile(ByVal Path As String)
    21. Dim SourceFile As Object, Line As String
    22. Dim ws As Excel.Worksheet
    23. Set ws = Sheets("Daten_Rechnungen") ' Zieldatei anlegen / ?berschreiben
    24. Set SourceFile = FSO.OpenTextFile(Path, 1) ' Quelldatei ?ffnen
    25. Do Until SourceFile.AtEndOfStream ' Gesamtes TextDok durchgehen
    26. Line = SourceFile.ReadLine ' Zeile aus Quelldatei einlesen
    27. If InStr(Line, szSuch1) Then
    28. ws.Cells(i, 1).Value = Line 'Wert in Zelle schreiben
    29. i = i + 1 'Z?hler f?r n?chste Zeile erh?hen ' Zeile in Zieldatei schreiben
    30. ElseIf InStr(Line, szSuch2) Then
    31. ws.Cells(j, 2).Value = Line 'Wert in Zelle schreiben
    32. j = j + 1 'Z?hler f?r n?chste Zeile erh?hen ' Zeile in Zieldatei schreiben
    33. End If
    34. Loop
    35. End Sub
    Eigentlich kannst du die Zeile 25 auch noch vor die Zeile 10 verschieben.
    Und die Zeile 26 vor die Zeile 12.
    Da ändert sich ja während des Programmablaufs auch nichts dran.

    Die bei jedem Durchlauf zu definieren schadet zwar nichts, aber ist etwas überflüssig.
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Wurde soeben erledigt.

    Ich will nicht zur Last fallen, aber ein Anliegen hab ich noch.

    Der Code liest ja jeweils zwei Zeilen aus den TXTs aus:
    Zeile 1 = Kundennummer (Auflistung in Spalte A)
    Zeile 2 = AS-Nummer (Auflistung in Spalte B)

    Leider ist es jetzt so, dass die Kundennummer in jeder TXT nur einmal, die AS-Nummern aber auch mehrfach in unterschiedliche Anzahl vorkommen können.

    Meine bisherige manuelle Zusammenstellung sah z.B. bisher so aus:

    1. Kundennummer AS-Nr.
    2. Kundennummer AS-Nr.
    . AS-Nr.
    . AS-Nr.
    . AS-Nr.
    3. Kundennummer AS-Nr.
    . AS-Nr.
    4. Kundennummer AS-Nr.

    Da der VBA-Code nun alles wie gewünscht untereinander wegschreibt, kommt es aufgrund der unterschiedlichen Anzahl an zu importierenden Zeilen ´zwangsläufig zu einem Versatz und die Kundennummern stimmen nicht mehr mit den AS-Nr. überein.

    Ich hab auch schon versucht, andere Zeilen and den TXT mit den benötigten daten zu entnehmen, aber auch hier stimmt die Zeilenanzahl nicht.

    Wie würde sich ein solcher Versatz vermeiden lassen?


    Dieser Beitrag wurde bereits 2 mal editiert, zuletzt von „Marco123“ ()

    Indem du keine 2 Zähler (i,j) verwendest, sondern nur den Zähler j.
    Also anstatt

    Marco123 schrieb:

    If InStr(Line, szSuch1) Then
    ws.Cells(i, 1).Value = Line 'Wert in Zelle schreiben
    i = i + 1 'Z?hler f?r n?chste Zeile erh?hen ' Zeile in Zieldatei schreiben
    ElseIf InStr(Line, szSuch2) Then
    ws.Cells(j, 2).Value = Line 'Wert in Zelle schreiben
    j = j + 1 'Z?hler f?r n?chste Zeile erh?hen ' Zeile in Zieldatei schreiben
    End If

    so:

    Visual Basic-Quellcode

    1. ​If InStr(Line, szSuch1) Then
    2. ws.Cells(j, 1).Value = Line 'Wert in Spalte A schreiben
    3. ElseIf InStr(Line, szSuch2) Then
    4. ws.Cells(j, 2).Value = Line 'Wert in Spalte B schreiben
    5. j = j + 1 'Zähler für nächste Zeile erhöhen
    6. End If
    --
    If Not Program.isWorking Then Code.Debug Else Code.DoNotTouch
    --
    Das ist der Hammer.
    Funktioniert genauso, wie es mir erträumt habe :)

    Vielen Dank für Deine grandiose Hilfe.

    Und hier für alle Interessierten:

    Quellcode

    1. Option Explicit
    2. Dim FSO As Object
    3. Const RootFolderName = "D:\"
    4. Const FileNameFilter = "*.txt"
    5. Const szSuch1 = "105981" ' Suche nach Kundennummer
    6. Const szSuch2 = "AS:" 'Suche nach AS-Nummer
    7. Dim j As Integer 'Zählvariable
    8. Dim ws As Excel.Worksheet
    9. Sub LoopFolder()
    10. Dim Folder As Object, File As Object
    11. Set ws = Sheets("Daten_Rechnungen") ' Zieldatei anlegen / überschreiben
    12. j = 10
    13. If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    14. Set Folder = FSO.GetFolder(RootFolderName)
    15. For Each File In Folder.Files
    16. If File.Name Like FileNameFilter Then ReadTextFile File.Path
    17. Next
    18. End Sub
    19. Sub ReadTextFile(ByVal Path As String)
    20. Dim SourceFile As Object, Line As String
    21. Set SourceFile = FSO.OpenTextFile(Path, 1) ' Quelldatei öffnen
    22. 'Intersect(ws.UsedRange, ws.Range("A10:B" & Rows.Count)).ClearContents 'Tabelle vorher leeren
    23. Do Until SourceFile.AtEndOfStream ' Gesamtes TextDok durchgehen
    24. Line = SourceFile.ReadLine ' Zeile aus Quelldatei einlesen
    25. If InStr(Line, szSuch1) Then
    26. ws.Cells(j, 1).Value = Line 'Wert in Spalte A schreiben
    27. ElseIf InStr(Line, szSuch2) Then
    28. ws.Cells(j, 2).Value = Line 'Wert in Spalte B schreiben
    29. j = j + 1 'Zähler für nächste Zeile erhöhen
    30. End If
    31. Loop
    32. End Sub
    Hab grade nochmal etwas gebastelt

    Ziel des ganzen:
    => Adresse des Ordners aus eine Zelle entnehmen und nicht im Code festlegen

    Damit ist das ganze deutlich flexibler.

    Quellcode

    1. Option Explicit
    2. Dim FSO As Object
    3. Const FileNameFilter = "*.txt"
    4. Const szSuch1 = "105981" ' Suche nach Kundennummer
    5. Const szSuch2 = "AS:" 'Suche nach AS-Nummer
    6. Dim j As Integer 'Z?hlvariable
    7. Dim ws As Excel.Worksheet
    8. Sub LoopFolder()
    9. Dim RootFolderName As String
    10. RootFolderName = ActiveSheet.Range("A1") 'Quell-Adresse auslesen
    11. Dim Folder As Object, File As Object
    12. Set ws = Sheets("Daten_Rechnungen") ' Zieldatei anlegen / ?berschreiben
    13. j = 10
    14. If FSO Is Nothing Then Set FSO = CreateObject("Scripting.FileSystemObject")
    15. Set Folder = FSO.GetFolder(RootFolderName)
    16. For Each File In Folder.Files
    17. If File.Name Like FileNameFilter Then ReadTextFile File.Path
    18. Next
    19. End Sub
    20. Sub ReadTextFile(ByVal Path As String)
    21. Dim SourceFile As Object, Line As String
    22. Set SourceFile = FSO.OpenTextFile(Path, 1) ' Quelldatei ?ffnen
    23. 'Intersect(ws.UsedRange, ws.Range("A10:B" & Rows.Count)).ClearContents 'Tabelle vorher leeren
    24. Do Until SourceFile.AtEndOfStream ' Gesamtes TextDok durchgehen
    25. Line = SourceFile.ReadLine ' Zeile aus Quelldatei einlesen
    26. If InStr(Line, szSuch1) Then
    27. ws.Cells(j, 1).Value = Line 'Wert in Spalte A schreiben
    28. ElseIf InStr(Line, szSuch2) Then
    29. ws.Cells(j, 2).Value = Line 'Wert in Spalte B schreiben
    30. j = j + 1 'Z?hler f?r n?chste Zeile erh?hen
    31. End If
    32. Loop
    33. End Sub

    Dieser Beitrag wurde bereits 1 mal editiert, zuletzt von „Marco123“ ()