Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1472to1476
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Schleife zum Auslesen von TXT-Dateien

Schleife zum Auslesen von TXT-Dateien
11.02.2016 14:31:25
TXT-Dateien
Hallo zusammen,
für mein Anliegen,.txt Dateien automatisiert in eine Excel-Datei auszulesen, wurde mir hier im Forum bereits eine tolle Hilfe zu Verfügung gestellt:
https://www.herber.de/bbs/user/103466.xlsm
Ich stelle nun nachträglich fest, dass die Anzahl der auszulesenden Dateien doch enorm ist und einen erheblichen, manuellen Aufwand erzeugt, wenn man auf diese nun alle einzeln zugreifen muss.
Meine Frage:
Ist es möglich, in das bestehende Makro eine "Schleife" zu integrieren, die nicht auf eine einzelne Datei, sondern auf alle im ausgewählten Verzeichnis befindlichen txt-Dateien zugreift und diese sukzessive untereinander ausliest?
Lieben Dank vorab und viele Grüße
Nils

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife zum Auslesen von TXT-Dateien
11.02.2016 15:04:06
TXT-Dateien
Hallo Nils,
ungetestet mit Auswahldialog für das Verzeichnis und Do-Loop-Schleife für die txt-Dateien im Verzeichnis.
Gruß
Franz
Sub CSV_Importieren()
Dim pfad As String
Dim datei As Variant
Dim a As Variant, a2 As Variant, az As Variant
Dim s As String, s2 As String
Dim i&, dNr%, z&, sp&, zl&, spZ&, zlZ&, abzeile&, vorhanden&, pos&
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis mit den zu importierenden Text-Dateien auswählen"
If .Show = -1 Then
pfad = .SelectedItems(1)
Else
MsgBox ("Datenextraktion abgebrochen.")
Exit Sub
End If
End With
datei = Dir(pfad & "\*.txt") 'text-Dateien suchen
Application.ScreenUpdating = False
Do Until datei = ""
abzeile = Import.Range("J1") + 1
'Import.Cells.Clear
dNr = FreeFile
Open pfad & "\" & datei For Binary As #dNr
s = Space(LOF(dNr))
Get #dNr, 1, s
Close #dNr
a = Split(s, vbCrLf)
zl = UBound(a)
sp = 7
a2 = Import.Range("A" & abzeile, Import.Cells(zl + 1 + abzeile, sp))
z = 1
For zlZ = 0 To zl
pos = InStr(a(zlZ), "RE-")
If pos = 0 Then pos = InStr(a(zlZ), "LI-")
If pos = 0 Then pos = InStr(a(zlZ), "ST-")
If pos > 0 Then
s2 = Trim(Left(a(zlZ), pos - 1))
a2(z, 2) = Right(s2, 6)
a2(z, 1) = Trim(Left(s2, Len(s2) - 6))
s2 = Trim(Mid(a(zlZ), pos))
While InStr(s2, "  ") > 0
s2 = Replace(s2, "  ", " ")
Wend
'    MsgBox a2(z, 1) & " : " & a2(z, 2) & " : " & s2
az = Split(s2, " ")
'    For spZ = LBound(az) To UBound(az)
'      Debug.Print spZ & ": " & az(spZ)
'    Next
If UBound(az) > 3 Then
a2(z, 3) = "##Fehler##"
a2(z, 4) = Mid(a(zlZ), pos)
Else
For spZ = 0 To UBound(az)
a2(z, 3 + spZ) = az(spZ)
Next
End If
a2(z, 7) = pfad & "\" & datei
z = z + 1
End If
Next
Import.Range("A" & abzeile, Import.Cells(z + 1 + abzeile, sp)) = a2
Import.Range("J1") = abzeile + z - 2
datei = Dir 'nächste Datei suchen
Loop
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Schleife zum Auslesen von TXT-Dateien
11.02.2016 15:34:27
TXT-Dateien
Hallo Franz,
vielen Dank erstmal für Deine Hilfe. Das Makro läuft offenbar nur bis zur Verzeichnisauswahl. Im Auswahlverzeichnis werden dann keinen txt.Dateien gefunden, obwohl vorhanden. Der Debugger zeigt "Laufzeitfehler 424, Objekt erforderlich" an.
Viele Grüße
Nils

AW: Schleife zum Auslesen von TXT-Dateien
11.02.2016 16:38:29
TXT-Dateien
Hallo Franz,
Dein Code funktiniert einwandfrei - ich habe einen Fehler bei der Übertragung gemacht, sorry!
Lieben Dank nochmals für die Hilfe, viele Grüße,
Nils

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige