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