berndk
Nov 06, 2012, updated at Nov 07, 2012 (UTC)
view8849
view11
0
Goto Top

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

GermanQuestionVB for ApplicationsDevelopment
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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 193841

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

Printed on: April 25, 2024 at 22:04 o'clock

11 Comments
Latest comment
Goto Top
Member: bastla
bastla Nov 06, 2012 at 19:02:57 (UTC)
Goto Top
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 ... face-wink
Member: berndk
berndk Nov 06, 2012 updated at 19:25:32 (UTC)
Goto Top
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 face-wink
Werds das nächste mal besser machen face-wink
Member: bastla
bastla Nov 06, 2012 at 19:27:17 (UTC)
Goto Top
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
Member: berndk
berndk Nov 06, 2012 at 19:35:34 (UTC)
Goto Top
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
Member: bastla
bastla Nov 06, 2012 at 19:41:29 (UTC)
Goto Top
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
Member: berndk
berndk Nov 06, 2012 at 19:57:42 (UTC)
Goto Top
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
Member: bastla
bastla Nov 06, 2012 updated at 20:44:50 (UTC)
Goto Top
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
Member: berndk
berndk Nov 07, 2012 at 07:23:35 (UTC)
Goto Top
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
Member: berndk
berndk Nov 07, 2012 at 12:34:40 (UTC)
Goto Top
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
Member: bastla
bastla Nov 07, 2012 at 15:28:34 (UTC)
Goto Top
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
Member: berndk
berndk Nov 08, 2012 at 14:04:07 (UTC)
Goto Top
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
GermanQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments