Hallo!
Also jetzt das Ganze nochmal mit lesbarer Formatierung. Bis auf ein paar Sachen war der Code bei dir eigentlich richtig. Das mit dem fehlenden \ und das <> bleiben muss hatte ich ja schon geschrieben. Zu den Variablen nochmal.
pfad nimmer den Ablagepfad auf , da wo deine TXT Dateien liegen.
datei nimmt den Namen der TXT Datei auf so es eine gibt (Bezeichnung vllt. unglücklich gewählt), der Name wird automatisch über den DIR Befehl gesucht. Mann muss ihn nicht händisch eingeben.
Dein Workbooks.Opentext ist jetzt mit eingebaut. Hattest da eigentlich nur vergessen noch den Pfad vorher anzufügen.
So sollte es eigentlich aussehen. Habe mal ein paar Kommentare mehr reingemacht, damit man ungefähr weiß, was welcher Schritt macht. Die kann man ja nach dem kopieren wieder rauslöschen.
Sub auslesen()
Dim pfad As String
Dim datei As String
Dim speicherort
Dim struktur As Object
'die nächste Zeile wäre die Eingabe des Ablagepfades über eine INPUT Box
'pfad = inputbox "Pfad der einzulesenden Dateien angeben!"
'das hier wäre die Alternative, hier würde man über den Ordner aussuchen können
MsgBox "Bitte im nächsten Fenster den entsprechenden Ordner auswählen und mit OK bestätigen!"
Set struktur = Application.FileDialog(msoFileDialogFolderPicker)
With struktur
.Title = "Pfad suchen"
'.InitialFileName = "Y:\Eigene Dateien" 'Anfangsordner für suche, kann man einstellen muss es aber nicht
If .Show = -1 Then
For Each speicherort In .SelectedItems
pfad = speicherort
Next speicherort
End If
End With
'in pfad ist nun der Pfad zu den TXT Dateien
'prüfen ob am Ende ein \ vom Pfad existiert, wenn nicht anhängen
If Right(pfad, 1) <> "\" Then pfad = pfad & "\"
'hier wird gesucht, ob de Pfad existiert und dort txt Dateien vorhanden sind, die letzte wird angezeigt, andere Dateitypen werden ignoriert
datei = Dir(pfad & "*.txt")
'in Datei ist nun entweder ein Dateiname oder wenn keine solche Datei existiert ""
' bei Dateinamen in die Schleife gehen und in Excel einfügen, ansonsten passiert nichts
Do While datei <> ""
' Filename ist der Pfad zu den TXT Dateien verkettet mit Dateiname, hierfür war das einfügen von \ notwendig, sonst gibt es einen Fehler
Workbooks.OpenText Filename:=pfad & datei, Semicolon:=True
' ggf. noch speichern, oder was anderes machen
datei = Dir 'ruft das nächste Element auf, wenn es eins gibt steht in datei wieder der Name sonst halt ""
Loop
End Sub
Das sollte jetzt passen. Die TXT Dateien werden je in ein EXCEL-Workbook gepackt. Die müsstest du dann halt noch ggf. weiterbearbeiten (bspw. speichern etc.). Theoreitsch könntest du die im selben Ordner (wo die TXT liegen) speichern und dann die TXT löschen. Den Code stören andere Dateitypen im selben Ordner nicht.
Wünsche dann schonmal nen schönen 1.Advent
Gruß Matthias
|