Textdateien aus fortlaufenden Unterordnern in Excel importieren

[xChristianx]

Hallo liebe Community,

bisher konnte ich immer eine zufriedenstellende Antowrt auf meine Frage bekommen. Ich hoffe das ist auch dieses mal der Fall.
Folgende Situation:

Ich habe einen exemplarischen Pfad: C:\data\office\Christian\Projekt xx\... in dem Ordner "Projekt xx" sind beliebig viele Unterordner, nummeriert von 1 - n.
In diesen Unterordnern, sind i.d.R. 9 oder 6 Textdateien. Seltener aber auch mal nur 3. Diese Textdateien werden per Hand in die Ordner kopiert.
Nun habe ich folgendes Makro.

Code:

Sub TeilHinzufügen()
For n = 1 To 9              'entsprechend 9 oder 6 Textdateien         
Sheets("Teil_hinzu").Select ' hier werden die textdateien kurz zwischengespeichert bzw importiert
Dim zahl As Integer
zahl = Cells(1, 2)          ' Startzeile in der eine Spalte der Textdatei abgelegt werden soll    
    Range("A4").Select      ' hier soll die Textdatei eingefügt werden
    Selection.QueryTable.Refresh BackgroundQuery:=False  'so wählen ich die Datei aus
   Range("G4").Select
   Range(Selection, Selection.End(xlDown)).Select
    Range("G4:G130").Select  'dieser Bereich aus der Textdatei interessiert mich 
    Selection.Copy
   Sheets("Daten").Select   ' hier soll die Range("G4:G130") eingefügt werden...
    Range("k" & zahl).Select '...in der entsprechenden Startzeile die ich in Cells(1,2) zuvor festgelegt habe
   Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
       False, Transpose:=True    'natürlich soll die Spalte transponiert werden
    Sheets("Teil_hinzu").Select
   zahl = zahl + 1             'und zahl nimmt um 1, um nächste Datenreihe zu kopieren
    Cells(1, 2) = zahl         
Next n
End Sub

Dieses Makro funktioniert bisher auch eigentlich sehr gut. Allerdings dauert es doch recht lange alle Textdateien jedes mal manuell auszuwählen.
Jetzt würde ich gerne folgendes realisieren, jedoch fehlen mir die Kenntnisse in Excel VBA. Ich hoffe hier kann mir jemand unterstützend zur Seite stehen.
Und zwar würde ich gerne umsetzten, dass
- Excel automatisch die Unterordner 1, 2, 3, ... ,n durchgeht und jeweils alle vorhandenen Textdateien aus einem Ordner in Excel auf dem Tabellenblat "Teil_hinzu" nebeneinander einfügt.
- d.h. ich würde gerne per Knopfdruck realisieren, was ich vorher mit unzähligen Klicks gemacht habe.
Die Textdateien haben immer eine feste Anzahl an Spalten. Die erste Zelle in der die erste Textdatei eingefügt werden soll ist nach wie vor A4. Die zweite ist dann N4, die dritte AA4 usw.
Wenn alle 9 oder 6 Dateien auf dem Tabellenblatt "Teil_hinzu" importiert sind, dann greifen meine bisherigen Codezeilen. (bestimmte  Spalte kopieren und nach Tabellenblatt "Daten" kopieren)
Danach springt Excel in den nächsten Ordner und macht wieder das gleiche, solange wie Ordner vorhanden sind.
Also Excel muss demnach immer in einen Ordner rein, alles rauskopieren dann wieder zurück im Pfad und in den nächsten Ordner.
Ich hoffe mir kann jemand mit diesem Problem weiter helfen.
Mit freundlichen Grüßen
Christian

[Fennek]

Hallo Chrsitian,

unter der Voraussetzung, dass die Dateinamen keine Leer- bzw Sonderzeichen enthalten, sollte der Supercode von snb helfen:

Code:

Private Sub Dateien_lesen()
'falls in Pfad oder Datei_namen Leerzeichen sind, "" benutzen
sPath = "C:\data\office\Christian\Projekt xx\" ' <<<< anpassen
sFile = "*.txt"   ' <<<< anpassen
ar = Split(CreateObject("wscript.shell").exec("cmd /c Dir " & sPath & sFile & " /s/o-d").stdout.readall, vbCrLf) '(0)

'Debug.Print UBound(ar) 'oder in einem leeren sheet
cells(1,1).resize(ubound(ar)) = ar
End Sub

Der Schalter "/s" erfasst alle Unterverzeichnisse, "/o-d" sortiert nach Datum.

Danach müssen alle Dateien nacheinander mit "workbooks.open" bzw "workbooks.openText" geöffnet werden.

mfg

[xChristianx]

Hi danke für deine schnelle Antwort.

Leider verstehe ich überhaupt nicht was dieser Supercode macht. Kannst du ihn erklären?

[Fennek]

Hallo,

nur ein paar kurze Hinweise:

Die genannte Konstruktion ist eine Anwendung des alten DOS-Befehlls "Dir" (Auflisten von DAteien) und klappt denentsprechend nur unter Windows.
2
Zum Kennenlernen im Menu unter "Ausführen" einfach cmd.exe eingeben und dann die Hilfe aufrufen mit "dir /?".

mfg

[Gast 123]

Hallo,

höfliche Frage, ist mit dem Code von Fennek die Sache abgeschlossen??  Auf meinem PC klappt es nicht.  Den Original Code kann man um Select kürzen, wobei mir dieser Teil völlig unbekannt ist?? Was passiert da genau??  Range("A4").QueryTable.Refresh BackgroundQuery:=False

Den Code könnte man wie unten kürzen, wobei mich die Zieladresse zum einfügen verwirrt. Oben steht es soll in A4, N4, AA4 kopiert werden. In deinem Original sehe ich das die Daten aber nur nach unten eingefügt werden, mit diesem Befehl: Range("k" & Zahl) Da gibt es aber keine Spalten A4, N4, AA4, sondern kopiert nur eine Zeile tiefer. Am besten ist eine kleine Beispieldatei wo man die Quelldaten und die Lösung wie es aussehen soll sehen kann.

mfg  Gast 123

Code:

Sub TeilHinzufügen()
Dim Zahl As Integer
Sheets("Teil_hinzu").Select ' hier werden die textdateien kurz zwischengespeichert bzw importiert

For n = 1 To 9              'entsprechend 9 oder 6 Textdateien
With Sheets("Teil_hinzu")
   Zahl = Cells(1, 2)      ' Startzeile in der eine Spalte der Textdatei abgelegt werden soll
   
   'hier soll die Textdatei eingefügt werden
   Range("A4").QueryTable.Refresh BackgroundQuery:=False  'so wählen ich die Datei aus
 
   Range("G4:G130").Copy  'dieser Bereich aus der Textdatei interessiert mich
  ' hier soll die Range("G4:G130") eingefügt werden...
  Sheets("Daten").Range("k" & Zahl).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, _
     SkipBlanks:=False, Transpose:=True     'natürlich soll die Spalte transponiert werden
  Application.CutCopyMode = False
   
  Zahl = Zahl + 1      'und zahl nimmt um 1, um nächste Datenreihe zu kopieren
  Cells(1, 2) = Zahl
Next n
End Sub

,

[xChristianx]

Hi habe mein Problem ganz einfach mit einer For-Schleife lösen können. Schau es dir mal an.

Code:

Sub Schweißkurvendaten_Einlesen()
Dim cDir As String
Dim sPath As String
Dim j As Long
Dim Unterordner As Long

x = 8


For Unterordner = 1 To 5   'bei 10 Unterordner einfach For Unterordner = 1 To 10

sPath = Tabelle2.Cells(1, 2) & "\" & Unterordner & "\"   'Der Quellpfad steht in Cells(1,2) und die Ordner haben den Namen 1-n

Debug.Print Tabelle2.Cells(1, 2)
cDir = Dir(sPath & "*.txt")


Do While cDir <> "" 'Solange wie es daten gibt, läuft die schleife

'--------------------------------
' ab hier beginnt der individuelle Import, bzw das was du mit der Textdatei machen möchtest
'--------------------------------
   j = 2
   Workbooks.Open (sPath & cDir)    'die Textdateien werden geöffnet
  
   For i = 12 To 142                
     Tabelle2.Cells(x, i) = ActiveWorkbook.ActiveSheet.Cells(j, 7)    
     j = j + 1   

   Next i

ActiveWorkbook.Close False
x = x + 1
cDir = Dir


'-----------------------------
' Import-Befehl Ende
'-----------------------------
Loop
Next Unterordner

End Sub

Ich beschreibe mal kurz den Code.
Da meine Unterordner mit 1-n benannt sind kann man mein Problem mit einer For-Schleife ganz einfach lösen.
Die erste For-Schleife läuft so oft durch wie Unterordner vorhanden sind. In diesem Fall 5 mal.
sPath ist der Pfad, den ich in der Exceltabelle in die Zelle Cells(1,2) schreibe.
Sagen wir der Pfad lautet: C:\Test\"hier sind die ganzen Unterordner mit dem Namen 1, 2, 3,...,n"\
Und die Variable Unterordner verdeutlicht genau die Zahlen 1 2 3 ... n
Jetzt haben wir schon einmal das "hin und her springen" zwischen den Unterordnern gesichert.
Als nächstes brauchen wir den Befehl was passieren soll wenn er in einem Unterodner drin ist.
Dafür benötigen wir cDir = Dir(sPath & "*.txt")
Die Do While Schleife soll so lange ausgeführt werden wie Textdateien in einem Ordner vorhanden sind. (<>"")
Dann beginnen die individuellen Befehle was nun mit den textdateien geschehen soll.
In meinem Fall:
- Die erste Textdatei soll geöffnet werden  (Workbooks.Open (sPath & cDir))
- Dann soll die Zahl in der Zelle Cells(j,7) in die Zelle des Tabellenblatts 2, Cells(x,i) gepackt werden.
- j = j + 1 damit die nächste Zelle eine Zeile weiter aus der Textdatei kopiert wird
- Die erste Textdatei soll geschlossen werden (ActiveWorkbook.Close False)
- dann x = x +1 damit die nächste zahl in die Zelle daneben kopiert werden kann
- Dieser Vorgang wird 130 mal gemacht
- Sind die 130 Durchläufe durch, dann wird die nächste Textdatei im ersten Unterordner geöffnet
Wenn alle Textdateien durch sind, ist die Do-While-Schleife für den ersten Unterordner beendet und dann kommt
Next Unterordner
Ich weiß, nicht sehr detailliert beschrieben, aber ich hoffe man kann damit was anfangen!

[Gast 123]

Hallo Christian,

ich habe nicht die Originaldatei vorliegen, und mit 1 Unterordner probiert.  Scheint gut zu klappen.  (i + x sind nicht mit Dim deklariert)
Einziger Tipp von mir:   über Sub  eine Const Anweisung setzen:  Const UO = 5  '10 bei 10 Unterordner
und die Zahl 10 in der For Next Schleife durch UO ersetzen. Dann kannst du den Wert oben auf 10 aendern.
 
Anbei noch eine Makro Version die ich ausprobiert habe um aus -geschlossener Arbeitsmappe- per Formel auslesen. Die Werte kann man noch mit Copy und einfügen als PasteSpecial xlValues wieder in Werte umwandeln. Bei Excel Mappen kann man aus geschlossenen Dateien auslesen, bei .txt weiss ich nicht ob es geht.  Probier es einfach mal aus. Hier der Code:

mfg  Gast 123

Code:

Option Explicit
Const UO = 5  '10 bei 10 Unterordner


'Modul für geschlossene Dateien auslesen

Sub Schweißkurvendaten_Einlesen()
Dim Adr As String, FmlTxt As String
Dim cDir As String
Dim sPath As String
Dim j As Long, i, x
Dim Unterordner As Long

x = 8

For Unterordner = 1 To UO   'bei 10 Unterordner einfach UO = 10

'Der Quellpfad steht in Cells(1,2) und die Ordner haben den Namen 1-n
sPath = Tabelle2.Cells(1, 2) & "\" & Unterordner & "\"

Debug.Print Tabelle2.Cells(1, 2)
cDir = Dir(sPath & "*.txt")

Do While cDir <> "" 'Solange wie es daten gibt, läuft die schleife

'-------------------------------- 
' ab hier beginnt der individuelle Import, bzw das was du mit der Textdatei machen möchtest
'--------------------------------
  j = 2

  FmlTxt = sPath & "[" & cDir & "]Tabelle1'!"
 
  For i = 12 To 142
     Adr = Cells(j, 6).Address
     Tabelle2.Cells(x, i).FormulaLocal = "='" & FmlTxt & Adr
     
     j = j + 1
  Next i

x = x + 1
cDir = Dir

'-----------------------------
' Import-Befehl Ende
'-----------------------------
Loop
Next Unterordner

End Sub