Textdateien zusammenführen

Hallo Excel-Community,
ich suche einen Weg, wie ich mit Excel (VBA) folgendes Problem lösen kann.
In einem bestimmten Verzeichnis befinden sich viele (ggf. hunderte) Textdateien identischen inhaltlichen Aufbaus, dessen Inhalte ich in Masse in einer Excel-Tabelle zusammenführen möchte.
Die Dateinamen der Textdateien sind stets so aufgebaut:
"Archiv" + Datum + Uhrzeit.txt
Beispiel: Archiv04_10_2012 09-19-05.txt
Der Inhalt der Dateien ist immer so aufgebaut:


00001/4/   /        /00174432     /*1      /        /
00002/4/   /        /00174428     /*1      /        /
00003/4/   /        /00174437     /*1      /        /

Es handelt sich um sieben Spalten, der "/" ist als Trennzeichen zu verstehen.
Ich hätte nun gern im Ergebnis eine Tabelle, die die Inhalte der einzelnen Textdateien zusammenführt, und zwar jede "Spalte" in eine separate Excel-Spalte. Die Spalten drei, vier und sieben sind leer. In Spalte fünf sind nur die Ziffern (immer achtstellig) von Interesse.
Zudem müsste jeder Datensatz (Zeile) ergänzt werden um das Datum und die Uhrzeit (jeweils eine Spalte) aus dem Dateinamen der ursprünglichen Textdatei.
Anbei befindet sich zur Veranschaulichung ein ZIP-Archiv mit einigen Textdateien.
https://www.herber.de/bbs/user/87134.zip
Ich würde mich freuen, wenn sich in diesem Forum wieder jemand findet, der dieses Problem lösen kann!
Vielen Dank!
MfG
PeMoe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Zusammenfassen() Dim strFile As String, oDaten As Object, arrDaten, arrTmp, arrTmp2(1 To 9) Dim i As Integer, j As Integer Dim strDate As String, strTime As String Const strPfad As String = "c:\test\texte\" 'anpassen Set oDaten = CreateObject("Scripting.Dictionary") oDaten(0) = Array("S1", "S2", "S3", "S4", "S5", "S6", "S7", "Datum", "Zeit") strFile = Dir(strPfad & "Archiv*.txt") Do While strFile "" strDate = Replace(Mid(strFile, 7, 10), "_", ".") strTime = Replace(Mid(strFile, 18, 8), "-", ":") Open strPfad & strFile For Input As #1 arrDaten = Split(Input(LOF(1), 1), vbCrLf) Close #1 For i = 0 To UBound(arrDaten) arrTmp = Split(arrDaten(i), "/") If UBound(arrTmp) > -1 Then For j = 0 To 6 arrTmp2(j + 1) = arrTmp(j) Next arrTmp2(8) = strDate arrTmp2(9) = strTime oDaten(oDaten.Count + 1) = arrTmp2 End If Next i strFile = Dir Loop arrTmp = oDaten.items arrTmp = WorksheetFunction.Transpose(arrTmp) arrTmp = WorksheetFunction.Transpose(arrTmp) Sheets(1).Cells(1, 1).Resize(UBound(arrTmp), 9) = arrTmp End Sub

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread