Werte aus txt-File in Excel einlesen

Option Explicit

Sub Einlesen()

Dim Kunde As String, Kundenfeld As Integer, Feldauswahl(), Feldbezeichnungen()
Dim fso As Object, TextDatei As Object, Felder() As String, Zeile As Integer, i As Integer, Daten() As String

'####### Anpassungen #######  
Const Datei As String = "D:\Datei mit Buchungen.txt"  

Kunde = "1212" 'nur Daten dieses Kunden übernehmen ("" für: alle Kunden)  
Kundenfeld = 4 'Lfd (Zeilen-)Nummer des Feldes mit der Kundennummer lt Textdatei  

Feldbezeichnungen = Array("FIRMENNUMMER (MANDANT)", "KUNDENNUMMER", "KUNDENINDEX", "LIEFERUNGS-/LEISTUNGSDATUM", "FEHLER")  
Feldauswahl = Array(3, 4, 5, 6, 30) 'Lfd (Zeilen-)Nummer des in die Tabelle einzutragenden Feldes  

Zeile = 1 'Zeilennummer für Spaltenüberschriften  

Const Header As String = "?FELDBEZEICHNUNG FELDINHALT ""FEHLERTEXT" 'erstes Feld jeden Datensatzes  
Const FeldAnzahl As Integer = 30 'Feldanzahl je Datensatz  
'####### Anpassungen Ende #######  


For i = 0 To UBound(Feldbezeichnungen)
    Cells(Zeile, i + 1).Value = Feldbezeichnungen(i)
Next
Zeile = Zeile + 1

Set fso = CreateObject("Scripting.FileSystemObject")  
Set TextDatei = fso.OpenTextFile(Datei, 1)

If Not TextDatei.AtEndOfStream Then
    Do
        ReDim Felder(FeldAnzahl) 'Array für neuen Datensatz löschen  
        Felder(1) = TextDatei.ReadLine
        If UCase(Felder(1)) = UCase(Header) Then 'Datensatz gefunden  
            For i = 2 To FeldAnzahl
                If Not TextDatei.AtEndOfStream Then
                    Daten = Split(TextDatei.ReadLine, """")  
                    Felder(i) = Trim(Daten(UBound(Daten)))
                Else
                    MsgBox "Datensatz nicht vollständig!", vbExclamation, "Datenfehler"  
                    Exit Do
                End If
            Next
            If InStr(1, Felder(Kundenfeld), Kunde, vbTextCompare) Then 'nur Daten des vorgegebenen Kunden eintragen  
            'If Felder(Kundenfeld) = Kunde Then 'Daten nur bei exakter Übereinstimmung eintragen  
                For i = 0 To UBound(Feldauswahl) 'vorgegebene Felder in Tabelle eintragen  
                    Cells(Zeile, i + 1).Value = Felder(Feldauswahl(i))
                Next
                Zeile = Zeile + 1
            End If
        End If
    Loop Until TextDatei.AtEndOfStream
Else
    MsgBox "Die Datei " & Datei & " enthält keine Daten!", vbExclamation, "Keine Daten gefunden!"  
End If
TextDatei.Close
End Sub

'If Felder(Kundenfeld) = Kunde Then 'Daten nur bei exakter Übereinstimmung eintragen  

If InStr(1, Felder(Kundenfeld), Kunde, vbTextCompare) Then 'nur Daten des vorgegebenen Kunden eintragen  

Kunde = "1212" 'nur Daten dieses Kunden übernehmen ("" für: alle Kunden)  
Kundenfeld = 4 'Lfd (Zeilen-)Nummer des Feldes mit der Kundennummer lt Textdatei  

Kunde = "FORMAL FEHLERHAFT"  
Kundenfeld = 23