VBA Script .txt-Datei-Import

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo!
Es gibt verschiedene Möglichkeiten, eine davon ist die folgende, allerdings müssten die eingelesenen Daten dann in den Tabellenblättern noch in Spalten aufgeteilt werden - dazu muss aber ein Trennzeichen bekannt sein, ist also noch nicht im Code integriert. Außerdem funktioniert der Code nur unter gewissen Voraussetzungen (etwa dass alle benötigten Tabellenblätter existieren etc.), das aber nur am Rande. Code ist ungetestet, weil ich mir Dein Verzeichnis natürlich nicht nachbauen kann/will.

Sub a()
Const HAUPTPFAD$ = "C:\Test\" 'Hauptpfad anpassen
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Fso As Object, Txt As Object
Dim Verz, UVerz, Datei, Stapel As Collection
Dim Abc, i&
Abc = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
"N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Stapel = New Collection
Stapel.Add Fso.GetFolder(HAUPTPFAD)
Do While Stapel.Count > 0
Set Verz = Stapel(1)
Stapel.Remove 1
For Each UVerz In Verz.SubFolders
Stapel.Add UVerz
Next UVerz
For Each Datei In Verz.Files
For i = LBound(Abc) To UBound(Abc)
If Datei.Name Like Abc(i) & ".txt" Then
Set Txt = Datei.OpenAsTextStream(1, False)
With Txt
If Not .AtEndOfStream Then .SkipLine
Do Until .AtEndOfStream
With Wb.Worksheets(i + 1)
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0) = _
Txt.ReadLine
End With
Loop
End With
End If
Next i
Next Datei
Loop
Set Wb = Nothing: Set Fso = Nothing: Set Txt = Nothing: Erase Abc
End Sub

LG
Michael

Danke für die Antwort.
Ich möchte dies nun folgendermaßen lösen:
Ich habe nun mehrere Dateien, die aneinandergefügt werden sollen, in einem Ordner. Hier soll nur einmal die Überschrift eingefügt werden, danach nicht mehr. Nun habe ich davon mehrere Ordner. Der erste Ordner soll in Blatt 1 gespeichert werden, der 2. im zweiten usw.
Ich habe folgenden Code gefunden, weiß aber nicht wie ich dafür modifzieren muss:
Sub Input_Files_From_Path()
Dim strPfad As String
Dim strDatei As String
Dim intFF As Integer
Dim strText As String
Dim wks As Worksheet
Set wks = Tabelle21 'Anpassen ***********
strPfad = "d:\test\" 'Anpassen ***********
strDatei = Dir(strPfad & "*.txt") 'Anpassen ***********
Do While strDatei ""
intFF = FreeFile()
Open strPfad & strDatei For Input As #intFF
strText = Input(LOF(1), #intFF)
Close #intFF
WriteToClp strText
With wks
With .Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = 1
.TextToColumns .Cells(1), Space:=True
wks.Paste .Cells(1)
End With
End With
strDatei = Dir()
Loop
End Sub


Public Sub WriteToClp(txt As String)
Dim IE As Object
Set IE = CreateObject("HTMLfile")
IE.ParentWindow.ClipboardData.SetData "text", txt & ""
Set IE = Nothing
End Sub

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Script .txt-Datei-Import

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

306 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread