Dateinamen einlesen
22.06.2019 13:16:46
Manu
ich bin ein absoluter VBA Neuling und verzweifle leider gerade ein bisschen an einer wohl recht einfachen Aufgabe. Dieses Problem ist so zwar schon öfter da gewesen allerdings habe ich mir durch die anderen Foreneinträge nicht weiterhelfen können. Mit Hilfe diverser Webseiten hab ich mir ein Makro geschrieben das an sich funktioniert: Hier ging es erstmal darum alle txt Dateien eines Ordners in einer Exceltabelle hintereinander einzulesen und in überall wo ein Leerzeichen ist, soll eine neue Spalte begonnen werden. Diese sah wie folgt aus:
Sub einlesen()
Z = Sheets(1).UsedRange.Rows.Count
d = Dir("C:\Users\manu\Diiodmethan\")
'alle txt-Dateien Zeilenweise einlesen
Do While d ""
Open "C:\Users\manue\OneDrive\Desktop\Alles2\Diiodmethan\" & d For Input As #161
'filepath = Dir("C:\Users\manu\Diiodmethan\" & d)
Do While Not EOF(161)
Line Input #161, temp
Cells(Z + 1, 1) = temp
Z = Z + 1
Loop
Close #161
d = Dir
Loop
'Überall von in der txt ein Space war soll nun eine neue Zelle begonnen werden
For j = 1 To Z
Text = Split(Cells(j, 1), vbTab)
For i = 0 To UBound(Text)
Cells(j, i + 1) = Text(i)
Next
Next
Sheets(1).UsedRange.Columns.AutoFit
End Sub
Jedoch sind dies eine Reihe an Messwerten die ohne das Wissen aus welcher Messreihe sie stammen wertlos sind. Deshalb wollte ich, dass der Namen der gerade ausgelesenen Datei in der ebenso ausgelesen und in eine Zelle vor dem restlichen Text eingefügt wird. Hier hängt sich nun allerdings das Programm immer wieder auf. Der Fehler müsste sich irgendwo in den fett gedruckten Zeilen verstecken. Für jeglichen Tipp wäre ich unglaublich dankbar!
Sub einlesen()
Z = Sheets(1).UsedRange.Rows.Count
d = Dir("C:\Users\manu\Diiodmethan\")
'Dim filepath As String
'alle txt-Dateien Zeilenweise einlesen
Do While d ""
Open "C:\Users\manue\OneDrive\Desktop\Alles2\Diiodmethan\" & d For Input As #161
'filepath = Dir("C:\Users\manu\Diiodmethan\" & d)
Do While Not EOF(161)
Line Input #161, temp
Cells(Z + 1, 1) = temp
Z = Z + 1
Loop
'Extra Zeile für die Überschrift der Datei
Z = Z + 1
'Dateiname als Überschrift für die eingefügte Tabelle
'ThisWorkbook.Sheets(1).Cells(Z + 1, 1).Value = filepath
'filepath = Dir()
Close #161
d = Dir
Loop
'Überall von in der txt ein Space war soll nun eine neue Zelle begonnen werden
For j = 1 To Z
Text = Split(Cells(j, 1), vbTab)
For i = 0 To UBound(Text)
Cells(j, i + 1) = Text(i)
Next
Next
Sheets(1).UsedRange.Columns.AutoFit
End Sub