Wie per VBA Werte aus einer Textdatei auslesen?

[AleXSR700]

Hallo zusammen,

ich stehe aktuell vor dem Problem, dass ich gerne per VBA Informationen aus einer Textdatei auslesen will.
Dabei soll quasi folgendes gemacht werden:

1. Prüfen, ob eine Datei vorhanden ist, die mit den Zeichen beginnt, die in Zelle A1 stehen (bspw. "23-07-2019"). Dabei soll die Datei nur mit exakt diesen Zeichen beginnen und muss am Ende dieser Zeichen einen Unterstrich haben (z. B. "23-07-2019_Lesen" sollte er auswerten aber "23-07-2019x" sollte er nicht auslesen, weil kein "_" vorhanden ist)
2. Prüfen, ob in der ersten Zeile der Datei steht "Prüf-Nr. " und dann Zelle A1. Er soll also noch mal innerhalb der Datei prüfen, ob es wirklich die richtige Datei ist und nicht nur der Dateiname stimmt.
3. Ist diese Datei vorhanden und hat die korrekte erste Zeile, dann soll er die Zeile suchen, die mit dem Text aus Zelle A2 beginnt (bspw. "WertA2")
4. Ist keine solche Zeile vorhanden, dann soll der in die Zelle B2 nichts eintragen. Ist sie aber vorhanden, dann soll der Wert nach dem ersten ";" eingetragen werden

Beispieldatei wäre:

Code:

Prüf-Nr. 23-07-2019
Be;0.00E+00;;3.33E+04;1.66E+04;Bq/g;19.06.2019;;;;;
Ka;0.00E+00;;6.05E+01;2.99E+01;Bq/g;19.06.2019;;;;;
Kc;0.00E+00;;3.18E+02;1.56E+02;Bq/g;19.06.2019;;;;;
Sc;5.44E+03;;4.79E+02;2.38E+02;Bq/g;19.06.2019;;;;;
Crf;0.00E+00;;2.23E+05;1.11E+05;Bq/g;19.06.2019;;;;;

Hier wäre 

Code:

Zelle A1 = 23-07-2019
Zelle A2 = Sc

und entsprechend müsste am Ende in der Zelle B2 stehen "5.44E+03". Wobei es noch schön wäre, wenn er den Dezimalpunkt durch ein Dezimalkomma ersetzen würde.

Wäre das problemlos machbar? Ich konnte leider kein Beispiel finden, dass ich derart anpassen konnte, da doch einige Bedingungen abzuprüfen sind.

[Flotter Feger]

Hallo,

ganz einfach so ...  

Code:

Sub Einlesen()
Const Pfad As String = "C:\1\" ' <-- anpassen
Dim Datei As String
Dim TextStream As Variant
Dim Data As Variant
Dim FSO As Object
Dim i As Long

Datei = Dir(Pfad & Range("A1") & "*_.txt") '<-- anpassen ?

If Datei <> "" Then
    Set FSO = CreateObject("Scripting.FilesystemObject").opentextfile(Pfad & Datei)
    Data = FSO.Readall()
    TextStream = Split(Data, vbCrLf)
    If Split(TextStream(0), " ")(0) = "Prüf-Nr." _
      And Split(TextStream(0), " ")(1) = Range("A1").Text Then
        For i = 1 To UBound(TextStream)
            If Split(TextStream(i), ";")(0) = Range("A2").Text Then
                Range("B2").Value = Replace(Split(TextStream(i), ";")(1), ".", ",")
                Exit Sub
            End If
        Next i
        MsgBox "Nichts gefunden."
    End If
End If
End Sub

[AleXSR700]

Hallo,

ganz einfach so ...  

Danke dir :-)

Leider scheine ich entweder was falsch angepasst zu haben, oder es fehlt noch irgendetwas.

Ich habe jetzt mal auf das Laufwerk H: eine Datei namens Test.txt gelegt.
Der Inhalt der Datei lautet:

Code:

Prüf-Nr. 24-07-2019
Be;0.00E+00;;3.33E+04;1.66E+04;Bq/g;19.06.2019;;;;;
Ka;0.00E+00;;6.05E+01;2.99E+01;Bq/g;19.06.2019;;;;;
Kc;0.00E+00;;3.18E+02;1.56E+02;Bq/g;19.06.2019;;;;;
Sc;5.44E+03;;4.79E+02;2.38E+02;Bq/g;19.06.2019;;;;;
Crf;0.00E+00;;2.23E+05;1.11E+05;Bq/g;19.06.2019;;;;;

Ich habe dann deinen Code mal testweise angepasst und dann, um Fehler auszuschliessen, die Namen der Datei und des Suchbegriffes fest definiert.

Code:

Sub Einlesen()
Const Pfad As String = "H:\"
Dim Datei As String
Dim TextStream As Variant
Dim Data As Variant
Dim FSO As Object
Dim i As Long

Datei = Dir(Pfad & "Test" & ".txt")

If Datei <> "" Then
    Set FSO = CreateObject("Scripting.FilesystemObject").opentextfile(Pfad & Datei)
    Data = FSO.Readall()
    TextStream = Split(Data, vbCrLf)
    If Split(TextStream(0), " ")(0) = "Prüf-Nr." _
      And Split(TextStream(0), " ")(1) = "24-07-2019" Then
        For i = 1 To UBound(TextStream)
            If Split(TextStream(i), ";")(0) = "Sc" Then
                Range("B39").Value = Replace(Split(TextStream(i), ";")(1), ".", ",")
                Exit Sub
            End If
        Next i
        MsgBox "Nichts gefunden."
    End If
End If
End Sub

Führe ich das Ganze aus, dann passiert einfach nichts. Er bringt keine Fehlermeldung, tut aber auch nichts.
Irgendeine Idee?

Undn eine kleine Nachfrage: Wieso ist bei "Datei" eigentlich der Pfad definiert? Später kommt nämlich opentextfile(Pfad & Datei), aber ist der Pfad nicht in Datei bereits enthalten?

[Flotter Feger]

Hallo,

im Code fehlt gar nichts ... ist natürlich von mir getestet.

Der Code gehört ins Tabellenblatt, in dem die Daten stehen.

Sabina
Von meinem Blackberry gesendet

[steve1da]

Hola,

zur Info:
http://office-loesung.de/p/viewtopic.php?f=166&t=810218

Gruß,
steve1da

[AleXSR700]

Danke @Flotter Feger!!!

Ich habe es jetzt ans Laufen gebracht. So dumm von mir, dass ich es nicht in die Tabelle, sondern die Arbeitsmappe gelegt habe 

Habe nun noch eine For Schleife eingebaut, damit er die Datei mehrfach durchläuft und somit mehrere Zuordnungen machen kann :-)