Text-Dateien importieren (VBA)

[xChristianx]

Hallo liebe Community,

bisher habt ihr mir gut helfen können.
Ich habe erneut ein Anliegen.

Ich habe mehrere Ordner in denen immer 9 txt-Dateien sind die immer gleich aufgebaut sind.

Dazu habe ich folgenden Code erstellt.

Code:

Sub TextDateienImportieren()

For n = 1 To 9


Sheets("Zwischenspeicher").Select


Dim zahl As Integer


zahl = Cells(1, 2)      'hier wird festgelegt in welche Zeile auf dem Tabellenblatt "Daten" die Spalte kopiert wird 


    Range("A4").Select  'hier wird der Inhalt reinkopiert bzw. der Startpunkt festgelegt


    Selection.QueryTable.Refresh BackgroundQuery:=False   'hier importiere ich nach und nach die 9 textdateien


    Range("G4").Select     'Diese Spalte wird kopiert


    Range(Selection, Selection.End(xlDown)).Select


    Range("G4:G130").Select


   Selection.Copy


   Sheets("Datenspeicher").Select


   Range("z" & zahl).Select  'und hier der Zeile ("zahl") entsprechend eingefügt


    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _


       False, Transpose:=True


   Sheets("Zwischenspeicher").Select


   zahl = zahl + 1 'danach soll die spalte aus der neuen text datei in die nächste zeile kopiert werden.


    Cells(1, 2) = zahl


Next n

End Sub

So weit so gut.
Das Mako funktioniert, jedoch habe ich aktuell ca.100 Ordner, d.h. ich müsste 900 Text-Dateien auswählen.
Dies ist nicht nur zeitaufwendig sondern auch extrem nervig.
Wie schaffe ich es, dass ich zumindest ersteinmal alle Textdateien innerhalb eines Ordners, den ich auswähle in das Tabellenblatt  "Zwischenspeicher" kopieren kann. Dann könnte ich wenigsten die relevanten Spalten der 9 Text-dateien auf einen Schlag auf das Tabellenblatt "Datenspeicher" verteilen. Dann hätte ich schonmal die Anzahl der Klick von 900 auf 100 reduziert.
Noch besser wäre es natürlich wenn Excel immer einen Pfad zurückspringt und dann die Ordner 1,2,3,4,....,100 durchgeht und die Textdateien pro Schleifendurchlauf kopiert und demnach 100 mal eine Schleife durchläuft. 
D.h. 1 klick, und Excel geht so vor (Modellierung):
Ordnerpfad festlegen in denen alle 100 Unterordner liegen: (Beispiel: C:\...\Hier die 100 Ordner\
Steuerelement klicken
Schleife startet (Bedingung ist, solange Ordner vorhanden sind)
Schleife 1:
C:\...\Hier die 100 Ordner\Ordner 1
Textdatei 1 - 9 kopieren in "Zwischenspeicher"
relevanten Spalten auf "Datenspeicher" verteilen
wieder zurück zum Überordner C:\...\Hier die 100 Ordner\ springen
order = nächster order (hier fehlt mir die Variable, ich weiß nicht wie ich die Ordner variabel machen soll)
Schleife 2:
C:\...\Hier die 100 Ordner\Ordner 2
Textdatei 1 - 9 kopieren in "Zwischenspeicher"
relevanten Spalten auf "Datenspeicher" verteilen
wieder zurück zum Überordner C:\...\Hier die 100 Ordner\ springen
order = nächster order
......


Ich hoffe ihr könnte nachvollziehen was ich vor habe :D

Wenn jemand Anregungen, Lösungsvorschläge oder sonstige Idee hat wie man das Problem vielleicht anders/ besser lösen kann dann wäre ich euch sehr verbunden.

mfg

Christian

[Fennek]

Hallo,

xl ist bekanntlich relativ langsam im Öffnen von Dateien. Das Betriebssystem ist da wesentlich schneller.

Ein Ansatz könnte sein, zuerst alle txt-Dateien eines Ordnern in EINE Datei zusammenzulegen und dann diese größere mit xl zu importieren.

Es geht auch innerhalb eines VBA-Codes, aber zum Testen ist ein anderer Weg besser geeignet:

Öffne ein cmd-Fenster und navigiere in den Ordner mit den txt-Dateien

mit

copy *.txt alle.txt

kopiert man alles in eine Datei. 

Teste mal und berichte.

mfg

[schauan]

Hallöchen,

hier wäre mal eine Variante mit dem FileSystemObjekt (FSO) Du müsstest noch Dienen Import einbauen, siehe Kommentare. Ist jetzt nur im Texteditor geschrieben und nicht getestet.

Code:

Sub ImportFiles()
'Importiert Dateien von Unterordnern - eine Ebene
'Variablendeklarationen
'Objekte
Dim objSourceFolder As Object, objSubFolder As Object
'String
Dim strTextFile$
'Quellordner setzen
Set objSourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Test")
'Schleife ueber alle Unterordner (eine Ebene)
For Each objSubFolder In objSourceFolder.SubFolders
  'Textdatei mit Dir feststellen
  strTextfile = Dir(SubFolder.Path & "\*.TXT")
  'Schleife, solange Dir etwas zurueckgibt
  Do While strTextfile <> ""
    'Hier kommt Dein Import rein
    '...
    'Naechste Textdatei ermitteln
    strTextFile = Dir()
  'Ende Schleife, solange Dir etwas zurueckgibt
  Loop
'Ende Schleife ueber alle Unterordner (eine Ebene)
Next
End Sub

[Fennek]

Hallo,

in diesem Video wird gezeigt, wie man viele Datein ohne VBA importieren kann:

https://www.youtube.com/watch?v=0sm5jYtckQ4

Vielleicht hilft es.

mfg

[schauan]

Hallöchen,

in Deinem Code hast Du eventuell ein Stück vom Pfad vergessen?

Code:

Set objSourceFolder = CreateObject("Scripting.FileSystemObject").GetFolder("C:\Users\Documents\Test\")

Zwischen users und documents kommt nnormalerweise noch der user.

[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!