Hallo eexil44,

gestatte mir zum Anfang eine kleine Anmerkung. Ein Hallo am Anfang und ein Gruß am Ende würde Deinen Beitrag gleich viel netter aussehen lassen. Wenn Du zum Bäcker gehst sagst Du ja auch beim Reingehen "Guten Tag" und beim Gehen "Auf Wiedersehen". Denn die Leute, an die Du Deine Frage richtest, sitzen zwar am PC, sind aber dennoch Menschen.gestatte mir zum Anfang eine kleine Anmerkung. Ein Hallo am Anfang und ein Gruß am Ende würde Deinen Beitrag gleich viel netter aussehen lassen. Wenn Du zum Bäcker gehst sagst Du ja auch beim Reingehen "Guten Tag" und beim Gehen "Auf Wiedersehen". Denn die Leute, an die Du Deine Frage richtest, sitzen zwar am PC, sind aber dennoch Menschen.

Nun zu Deinen Wünschen. Kopiere nachfolgendes Makro in ein StandardModul und starte es über eine Befehlsschaltfläche.

[b]Option Explicit

Dim ReadFile As String

Sub Datei_einlesen()
Rem: Hilfsvariable für Anzahl Datensätze
Dim Text1 As String, firstRow As Integer
Rem: Variablen für den Array nötig
Dim Textzeile As Long, i As Long
Rem: Für Office97 muss das Array "Zeilentext" als String definiert werden
Dim Zeilentext As Variant, Pfad As String, Datei As String

Rem: Pfad festlegen
Pfad = "C:\"

Rem: Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False

Rem: Prüfen ob das Blatt, das nachfolgend eingefügt witrd, bereits vorhanden
Rem: Wenn ja, dann löschen
For i = Worksheets.Count To 1 Step -1
If Sheets(i).Name = "Daten" Then
Application.DisplayAlerts = False
Sheets(i).Delete
Application.DisplayAlerts = False
End If
Next

Rem: Leerblatt einfügen
Sheets.Add After:=Sheets(1)
With Sheets(2)
.Name = "Daten"
.Activate
End With

Rem: Anweisung zum Listen der Textdateien in dem Verzeichnis
Datei = Dir(Pfad & "*.txt")
Do While Datei <> ""

Rem: Wenn Abbruchtraste beatätigt wurde
On Error GoTo Weiter
If Datei = "" Then Exit Sub

Rem: Sprungmarke "Weiter"
Weiter:

Rem: Schliessen einer geöffneten Datei
Close #1

Rem: Öffnen der Textdatei
Open Datei For Input As #1

Rem: Zählvariable auf 0 setzen
Textzeile = 0

Rem: Schleife bis Dateiende
Do While Not EOF(1)
    Rem: Hilfsvariable zum Einlesen verwenden
    Line Input #1, Text1
    Rem: Zähler hochzählen
    Textzeile = Textzeile + 1
Loop

Rem: Schliessen der Datei weil Dateiende erreicht wurde
Close #1

Rem: Erneutes Öffnen der Datei zum Einlesen und um zum Dateianfang zu kommen
Open Datei For Input As #1

Rem: Array neu auf die Anzahl der Linien initialisieren
ReDim Zeilentext(Textzeile)

Rem: Schleife zum Einlesen der Dateien in das Array
For i = 5 To Textzeile - 1
firstRow = Sheets("Daten").Range("A65536").End(xlUp).Offset(1, 0).Row
Line Input #1, Zeilentext(i)
Sheets("Daten").Cells(firstRow, 1) = Zeilentext(i)
Next i
Close #1

Datei = Dir()
Loop

End Sub[/b]

In dem Makro in der Zeile

[b]Pfad = "C:\"[/b]

musst Du den Pfad des Verzeichnisses eintragen, in dem sich die Textdateien befinden.

Ich hoffe, Du kommst klar. Bei Fragen melde Dich wieder.

Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 3 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird. Solltest Du nicht wissen, wie Du den Code in Deine Datei bekommst, dann schau mal auf meiner HP in der Rubrik Anleitungen und dort dann in der Anleitungsnummer 2 nach. Dort stelle ich dazu eine bebilderte Anleitung zur Verfügung, die Dir sicherlich helfen wird.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

Du hast natürlich Recht. Ein "Gute Tag" oder "Hallo" ist auf jeden Fall angebracht. Werde Deinen Rat annehmen und Besserung geloben.

Bei Deinem Marko habe ich das Problem das zwar das neue Blatt " Daten erzeugt wird, die Dateien dann aber nicht importiert werden. Den Pfad habe ich vorher geändert.

Gruß EEXIL44

Hallo EEXIL44,

welche Endungen haben die Dateien, die eingelesen werden sollen?
Hast Du bei der Pfadangabe auch abschließen einen Backslasch ( \ ) eingefügt? Beispiel: Bei Daten im Ordner "Eigene Dateien" müsste der Pfad

"C:\Eigene Dateien\"

lauten. Pfadangabe immer in Anführungszeichen ("") setzen.

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

orinal haben die Dateien .vwh als Erweiterung. Es sind "normale TXT Dateien.
Auch wenn ich die Dateien umbennen und mit Backslash (hatte ich tatsächlich vergessen) klappt es nicht.
Fehler: Laufzeitfehler '53' Datei nicht gefunden.
Im Debugg Modus kann man aber sehen das die Variable "Datei" als Wert den richtigen Dateinamen hat (Datei = AAAA.txt).

Hallo EEXIL44,

wo bleibt denn der Code stehen? Welche Zeile wird gelb markiert? Besteht die Möglichkeit einer dieser "*..vwh-Dateien" mal ins Internet, z.B. bei http://www.netupload.de/ , zu stellen und den Link dann hier zu Posten, damit man das mal mit einer Deiner Dateien testen kann?

MfG,
Oliver
_{Da hier der einzige Lohn für die Helfer eine Rückmeldung ist, wäre es nett, wenn Du ein}
^{Feedback abgeben könntest, ob der Lösungsvorschlag Dein Problem gelöst hat.}

Hallo Oliver,

habe in der Zwischenzeit von einem Kollegen die fogende Lösung bekommen.

Sub DateiEinlesen()
Dim Datei, i&, ziel&
Datei = Application.GetOpenFilename("Textdateien (*.vwh), *.vwh", , "Wähle", , True)
If TypeName(Datei) = "Boolean" Then
If Datei = False Then Exit Sub
Else
For i = 1 To UBound(Datei)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Datei(i), Destination:=Range("A1").Offset(0, ziel + 2))
.Name = CStr(i)
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1)
.TextFileDecimalSeparator = ","
.TextFileThousandsSeparator = "."
.Refresh BackgroundQuery:=False

End With
Next i

End If
End Sub


Damit klappt das importieren prima. Nur stehen die Daten der einzelnen Dateien nebeneinander statt untereinander. Nicht ganz optimal da zum Teil mehr als 256 Dateien eingelesen werden sollen. Ich helfe mir jetzt so das ich den iÍmport 2x mache.

Vielen Danke für deine Hilfe!
Gruß EEXIL44