06.11.2012, aktualisiert am 07.11.2012

9120

VBA - erste Zeilen aus mehreren .txt Dateien in Excel importieren

Hallo beisammen,

bin kurz vor dem verzweifeln und benötige Hilfe.
ich möchte aus vielen .txt - Dateien nur die ersten 20 Zeilen in Excel importieren.
Es handelt sich um Messdaten die wie folgt in der .txt Dateien hinterlegt sind:

Run Label: Bernd-20121022-082146
Run Time: 22-Okt-2012 08:21
Device Serial: 45353763739
Method: Wurschd
Barr: Wurschd
Ba ID: 7777432
ID: 8834666

Result: Pass

User Name: Bernd
Login Time: 22-Okt-2012 08:20
Software Version: 4.88.42 (6697)
Last Tested: 22-Okt-2012 08:16
Last Test Result: Pass
Calibration Check: Pass
CCD Check: Pass
Laser Power: Pass
Warnings: None

samplespec 33 [response corrected]
-22915695 24.518190
-884929 24.202
-869773 24.3041

Folgendes Scripte habe ich schon soweit und funktioniert auch soweit.
Jedoch sollte die Zeile "Warnings: None" die letzte Zeile sein die immer eingelesen wird.

Wäre über Eure Hilfe dankbar.

Code:

Sub Alle_txt_Dateien_importiern()

    Dim strFile$
    Const strPfad$ = "C:\Testordner\"  
    strFile = Dir(strPfad & "*Messdaten*.txt", vbNormal)  
    Do Until Len(strFile) = 0
        With ActiveSheet
            .Cells(.Rows.Count, 2).End(xlUp).Offset(1, -1) = strFile
            With .QueryTables.Add(Connection:="TEXT;" & strPfad & strFile, _  
                Destination:=.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0))
                .AdjustColumnWidth = True
                .TextFileParseType = xlDelimited
                .TextFileSpaceDelimiter = False          'Leerzeichen  
                .TextFileCommaDelimiter = True           'Komma  
                .Refresh BackgroundQuery:=False
            End With
        End With
        strFile = Dir$
    Loop
    

End Sub

Viele Grüße und im Voraus vielen Dank!

Bernd

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 193841

Url: https://administrator.de/contentid/193841

Ausgedruckt am: 08.11.2024 um 09:11 Uhr

11 Kommentare

Neuester Kommentar

Hallo berndk!

Ich würde das etwas anders schreiben:

Sub Alle_txt_Dateien_importiern()

Const strPfad$ = "C:\Testordner\"  
Set fso = CreateObject("Scripting.FileSystemObject")  
strFile = Dir(strPfad & "*Messdaten*.txt", vbNormal)  

Rw = Cells(Rows.Count, 2).End(xlUp).Row
Do Until Len(strFile) = 0
    Cells(Rw, "A").Value = strFile  
    For Each Line In Split(fso.OpenTextFile(strPfad & strFile).ReadAll, vbNewLine)
        Cells(Rw, "B") = Line  
        Rw = Rw + 1
        If InStr(Line, "Warnings: None") > 0 Then Exit For  
    Next
    Rw = Rw + 1 'Zeilenabstand nach Datei  
    strFile = Dir$
Loop
Columns("A:B").AutoFit  
End Sub

Grüße
bastla

P.S.: Die Formatierung als "Code" lässt sich auch nachträglich noch vornehmen ...

Hallo Bastla,

vielen Dank!

Ich habs jetzt eben ausprobiert, ich bin absolut nicht der Held in VBA, aber er mit diesem Script listet er mir nur die Namen der bestehenden .txt - Dateien auf.
Ich möchte aber aus dem Inhalt die ca. ersten 20 Zeilen auslesen.
Mhhh, wie bastel ich denn das Script am besten dann so um?

Viele Grüße

Bernd

Sorry, muss noch was hinzufügen, in der Spalte "B" habe ich den Code "ÿþR" stehen.
Wo kann ich denn diesen Formatieren?

Ah, ja, und danke noch für den Tip mit dem Code

Werds das nächste mal besser machen

Hallo berndk!

Ich habe mit Deinem oben geposteten Beispiel

Run Label: Bernd-20121022-082146
Run Time: 22-Okt-2012 08:21
Device Serial: 45353763739
Method: Wurschd
Barr: Wurschd
Ba ID: 7777432
ID: 8834666


Result: Pass

User Name: Bernd
Login Time: 22-Okt-2012 08:20
Software Version: 4.88.42 (6697)
Last Tested: 22-Okt-2012 08:16
Last Test Result: Pass
Calibration Check: Pass
CCD Check: Pass
Laser Power: Pass
Warnings: None

samplespec 33 [response corrected]
-22915695 24.518190
-884929 24.202
-869773 24.3041
......
......
......

(als "Messdaten1.txt" gespeichert) getestet und als Ergebnis

Messdaten1.txt	Run Label: Bernd-20121022-082146
	Run Time: 22-Okt-2012 08:21
	Device Serial: 45353763739
	Method: Wurschd
	Barr: Wurschd
	Ba ID: 7777432
	ID: 8834666
	
	
	Result: Pass
	
	User Name: Bernd
	Login Time: 22-Okt-2012 08:20
	Software Version: 4.88.42 (6697)
	Last Tested: 22-Okt-2012 08:16
	Last Test Result: Pass
	Calibration Check: Pass
	CCD Check: Pass
	Laser Power: Pass
	Warnings: None

erhalten - versuch das doch bitte auch und vergleiche dann bitte eine Deiner Dateien mit der Testdatei, um die Ursache dafür, dass es bei Dir nicht funktioniert, zu finden ...

Grüße
bastla

Hi Bastla,
das versteh ich jetzt nicht, ich habe es so ausprobiert und es funktioniert prima dein Script.
Wenn ich jedoch die ursprüngliche .txt -Dateien importieren möchte, dann listet er mir nur die Bezeichnungen auf und in der Spalte "B" dann die Kryptische Zeichen: ÿþR

Die ursprünglichen .txt-Dateien sind ziemlich lang und haben ca. 4000 Zeilen, daher benötige ich nur die ca. oberen 20.

Hast du mir nen Tip?

Grüße

Bernd

Hallo berndk!

Falls es sich um Unicode-Dateien handeln sollte, müsste die Zeile 10 geändert werden:

    For Each Line In Split(fso.OpenTextFile(strPfad & strFile, 1, False, True).ReadAll, vbNewLine)

Grüße
bastla

Bastla,

Vielen Dank!! Erst hatte es funktioniert, jetzt bekomme ich folgende Fehlermeldung:
"Laufzeitfehler '62', Einlesen hinter Dateiende".
Diese Fehlemeldung hatte ich schon mal bei einem anderen Script und habe mich wund gegoogelt.
Sagt dir diese Meldung was?

Grüße

Bernd

Hallo berndk!

Im Hinblick darauf, dass per "ReadAll" ja eigentlich einfach der gesamte Dateiinhalt gelesen wird, dürfte der Fehler eigentlich nur bei einer leeren Textdatei auftreten ...

Falls das die Ursache war, sollte es so funktionieren:

Sub Alle_txt_Dateien_importiern()

Const strPfad$ = "C:\Testordner\"  
Set fso = CreateObject("Scripting.FileSystemObject")  
strFile = Dir(strPfad & "*Messdaten*.txt", vbNormal)  

Rw = Cells(Rows.Count, 2).End(xlUp).Row
Do Until Len(strFile) = 0
    Cells(Rw, "A").Value = strFile  
    Set FileIn = fso.OpenTextFile(strPfad & strFile, 1, False, True)
    If Not FileIn.AtEndOfStream Then
        For Each Line In Split(FileIn.ReadAll, vbNewLine)
            Cells(Rw, "B") = Line  
            Rw = Rw + 1
            If InStr(Line, "Warnings: None") > 0 Then Exit For  
        Next
    End If
    Rw = Rw + 1 'Zeilenabstand nach Datei  
    FileIn.Close
    strFile = Dir$
Loop
Columns("A:B").AutoFit  
End Sub

Grüße
bastla

Guten Morgen bastla,

du bist der Beste!
Vielen Dank, ja, das wars.
Warum auch immer, aber eine .txt-Datei war komplett leer und hatte dann den Fehler ausgelöst.

Morgen werde ich dann probieren dass ich die Zeilen noch getrennt bekomme (TabStops) und dann sollte es passen.

Herzlichen Dank noch!!

Viele Grüße

Bernd

Hallo bastla,

noch eine Frage, ich krieg das irgendwie nicht gebacken mit der Trennung.
Wie verbastel ich denn jetzt meine Tabstops getrennt etc... in das Script damit er mir die Daten getrennt in die Spalten schreibt?

...
Destination:=.Cells(.Rows.Count, 2).End(xlUp).Offset(1, 0))
                .AdjustColumnWidth = True
                .TextFileParseType = xlDelimited
                .TextFileSpaceDelimiter = False          'Leerzeichen  
                .TextFileCommaDelimiter = True           'Komma  
                .Refresh BackgroundQuery:=False
...

Soll ja dann so aussehen:

Spalte1 Spalte2 
Method: Wurschd
...
....

Vielen Dank schon mal für die Antwort.

Grüße

Bernd

Hallo berndk!

Versuch es damit:

Sub Alle_txt_Dateien_importiern()

Const strPfad$ = "C:\Testordner\"  
Set fso = CreateObject("Scripting.FileSystemObject")  
strFile = Dir(strPfad & "*Messdaten*.txt", vbNormal)  

FieldsMax = 0
Rw = Cells(Rows.Count, 2).End(xlUp).Row
Do Until Len(strFile) = 0
    Cells(Rw, "A").Value = strFile  
    Set FileIn = fso.OpenTextFile(strPfad & strFile)
    If Not FileIn.AtEndOfStream Then
        For Each Line In Split(FileIn.ReadAll, vbNewLine)
            Fields = Split(Line, vbTab) 'anhand TAB in Felder zerlegen  
            FieldsCount = UBound(Fields) + 1 'Feldanzahl ermitteln  
            If FieldsCount < 1 Then FieldsCount = 1 'bei leeren Zeilen Feldanzahl auf 1 setzen  
            If FieldsCount > FieldsMax Then FieldsMax = FieldsCount 'höchste Feldanzahl speichern (für AutoFit)  
            Cells(Rw, "B").Resize(1, FieldsCount).Value = Fields  
            Rw = Rw + 1
            If InStr(Line, "Warnings: None") > 0 Then Exit For  
        Next
        Rw = Rw + 1 'Zeilenabstand nach Datei  
    End If
    FileIn.Close
    strFile = Dir$
Loop
Columns("A").Resize(, FieldsMax + 1).AutoFit 'alle Spalten auf optimale Breite bringen  
End Sub

Grüße
bastla

Hallo bastla,

du bist absolut genial!!!
Läuft alles wunderbar, herzlichen Dank!!!!
Da hätt ich ne Ewigkeit dafür gebraucht, wenn ich es überhaupt hinbekommen hätte.

Viele Grüße

Bernd

Frage VB for Applications Entwicklung

Mehr von berndk

WDS mit XP automatisch formatierenberndk - 2 Kommentare

Heiß diskutiert