Importieren mehrerer txt Dateien

Hallo,
ich habe sehr viele .txt-Dateien in verschiedenen Unterordnern. Die .txt-Dateien haben alle den gleichen Namen, die Unterordner sind nach dem entsprechendem Datum benannt.
Ich möchte nun gerne den Inhalt aller .txt-Dateien in einem bestimmten Datumsbereich (den ich vorgeben können möchte) per Makro in ein Arbeitsblatt importieren. Also von Anfangsdatum bis Enddatum sollen alle .txt-Dateien in den Ordnern, die diesen Datumsbereich einschließen, importiert werden.
Die Inhalte der .txt-Dateien sollen untereinander und ohne Leerzeilen eingefügt werden. Reihenfolge ist relativ egal, da die Daten noch mit Formeln bearbeitet werden.
Es können auch die einzelnen Dateien in jeweils ein neues Tabellenblatt importiert werden, wichtig wäre dabei nur, dass die Namen der Tabellenblätter das Datum des Unterordners sind.
An sich ist eigentlich erstmal nur der Import aller Dateien das Wichtige. Das Verarbeiten klappt dann schon irgendwie.
Vielen Dank schon mal im Voraus für jede Hilfe.
MfG

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Jochen,
als Ansatz, evtl. musst du noch bisschen anpassen bei usedrange oder verzeichnisnamen


Sub TXTDateienZusammenKopieren()
''' kopiert viele TXT-Dateien in eine xls
Dim Awkb As Workbook
Dim ZielSht As Worksheet
Const Dateiname As String = "text.txt" 'fester dateiname
Dim Datei As String
Const Pfad As String = "X:\Documents\test\"
Dim Verzeichnis As String
Dim StartDatum As Variant
Dim EndDatum As Variant
Dim n As Long, m As Long, letzteZeile As Long
Set Awkb = ActiveWorkbook
Set ZielSht = Awkb.ActiveSheet
On Error Resume Next
StartDatum = InputBox("Importiere Dateien ab Datum: [TT.MM.JJ]")
EndDatum = InputBox("Importiere Dateien ab Datum: [TT.MM.JJ]")
If Not IsDate(StartDatum) Or Not IsDate(EndDatum) Then
MsgBox "kein Datum eingegeben! Abbruch!"
Exit Sub
End If
On Error GoTo 0
Err.Clear
'wie sind die verzeichnisnamen formatiert?
'JJJJMMTT ist hier am besten
StartDatum = CLng(Format(StartDatum, "YYYYMMDD"))
EndDatum = CLng(Format(EndDatum, "YYYYMMDD"))
ZielSht.Cells.Delete 'alle zellen werden gelöscht!!!
For n = StartDatum To EndDatum
Verzeichnis = Dir(Pfad & n, vbDirectory)
If Verzeichnis <> "" Then
Datei = Dir(Pfad & Verzeichnis & "\" & Dateiname)
If Datei <> "" Then
Workbooks.Open Pfad & Verzeichnis & "\" & Datei, ReadOnly:=True, Origin:=xlWindows
Windows.Arrange xlArrangeStyleVertical
ActiveWorkbook.ActiveSheet.UsedRange.Cells.Select
If ZielSht.UsedRange.Rows.Count = 1 Then
letzteZeile = 1
Else
letzteZeile = ZielSht.UsedRange.Rows.Count + 1
End If
'führende leerzeilen werden beim kopieren weggelassen
ActiveWorkbook.ActiveSheet.UsedRange.Cells.Copy ZielSht.Cells(letzteZeile, 1)
m = m + 1
Workbooks(Dateiname).Close False
Else
'keine datei im verzeichnis
End If
Else
'verzeichnis mit dem datum existiert nicht
End If
Next
MsgBox m & " Dateien wurden zusammengeführt."
End Sub

Rückmeldung erbeten!
Gruß
Ralf

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread