Auto Einlesen von Textdateien und Speichern als...

Hallo alle zusammen,
nach langer Zeit mal wieder eine Nuss zu knacken.
Ich brauch bitte eure Hilfe bei der Erstellung einer Schleife.
Siehe Datei .xlsx im Link.
https://www.herber.de/bbs/user/117723.xlsx
Die Beschreibung habe ich da auch reingeschrieben.
In A:A stehen importierte Dateinamen .txt aus einem Verzeichnis.
Ich lese nun manuell einen Textfile ein und splitte die Daten nach #:

Sub GetMSData()
Dim arr
Dim Datei
Dim FSO
Dim l As Long
Dim tmp As Variant
Dim vnt_Ausgabe As Variant
Dim i As Integer
Dim Str_String As String
Dim StrDatei As String
StrDatei = Tabelle1.Range("H1")
On Error GoTo GoRequest
Application.ScreenUpdating = False
'Textdatei auslesen
Set FSO = CreateObject("Scripting.FilesystemObject")
Set Datei = FSO.OpentextFile("\\Pfad\Pfad" & "\" & StrDatei") 'Anpassen
Str_String = Datei.readall
Datei.Close
arr = Split(Str_String, vbCrLf) 'Nach Datensätzen splitten
ReDim vnt_Ausgabe(UBound(arr), 10) '10 Spalten
For l = 0 To UBound(arr)
tmp = Split(arr(l), "#") 'Jeden Datensatz nach Werten splitten
For i = 0 To UBound(tmp)
vnt_Ausgabe(l, i) = tmp(i) 'Jeden Wert in das Array vnt_Ausgabe umschaufeln
Next
Next
'Ausgeben. Anpassen.
Tabelle2.Range("A1:A15000").ClearContents
Tabelle2.Range("A1").Resize(UBound(vnt_Ausgabe) + 1, UBound(vnt_Ausgabe, 2)) = vnt_Ausgabe
Application.ScreenUpdating = True
End Sub

Dann Speichere ich das Tabellenblatt als Datei:

Sub Speichern()
Dim TBName$, WBName$, WBPfad$
TBName = Tabelle2.Name
WBPfad = ThisWorkbook.Path
WBName = Tabelle1.Range("I1").Value ' oder via Schleife der Wert der aus A:A
If WBName = "" Then Exit Sub
Worksheets(TBName).Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs WBPfad & WBName
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

Wie kann ich daraus jetzt eine Schleife erstellen die Solange genau das tut
bis letzte aus A:A (also alle .txt sind jetzt auch .xlsx)
Danke mal für Eure hilfe
MfG
Nigel

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub alleEinlesen() Dim i as long Dim LRow as long Dim WB as Workbook Dim myPath as Sting myPath = "C:\temp\" '>>>>> LRow = cells(rows.count,1).end(xlup).row for i = 1 to LRow set WB = workbooks.open(myPath & cells(i,1)) WB.saveas cells(i,1), 51 WB.close next i End Sub

Sub alleEinlesen() Dim i As Long Dim LRow As Long Dim WB As Workbook Dim myPath As String myPath = "C:\Pfad\Pfad\" '>>>>> LRow = Cells(Rows.Count, 1).End(xlUp).Row For i = 1 To LRow Set WB = Workbooks.Open(myPath & Cells(i, 1)) Columns("A:A").Select Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _ Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _ :="~", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _ 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _ TrailingMinusNumbers:=True Dim act As String act = ActiveWorkbook.ActiveSheet.Name Application.DisplayAlerts = False WB.SaveAs Filename:= _ myPath & act, FileFormat:= _ xlOpenXMLWorkbook, CreateBackup:=False WB.Close Application.DisplayAlerts = True Next i End Sub

Beliebteste Forumthreads (12 Monate)

Auto Einlesen von Textdateien und Speichern als...

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

245 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Auto Einlesen von Textdateien und Speichern als...

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

245 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread