hi daniel :-)

ein beispiel :-))

gruss nighty

Option Explicit
Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
With Application.FileSearch
.NewSearch
.LookIn = "D:\Temp\"
.Filename = "*.txt"
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
zeile = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Application.FileSearch
    .NewSearch
    .LookIn = "D:\Temp\"
    .SearchSubFolders = True
    .Filename = "*.txt"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + "D:\Temp\" + DateiName, Destination:=Range("A" & zeile))
    .Name = "ob1201_2"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .Refresh BackgroundQuery:=False
End With
End If
End With
Next Dateien
End If
End With
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

hi daniel :-)

diesen abschnitt solltest du durch deine import daten ersetzen

gruss nighty

.Name = "ob1201_2"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False

hi daniel :-)

ich vergass noch :-))

gruss nighty

in den beiden zeilen ist der pfad anzupassen

.LookIn = "D:\Temp\"

With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + "D:\Temp\" + DateiName, Destination:=Range("A" & zeile))

deine importdaten kannst du erfassen in dem du eine datei importierst und diese gegen obige austauschst

hi daniel :-)

wie immer korrigiert grrr

gruss nighty

Option Explicit
Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
With Application.FileSearch
    .NewSearch
    .LookIn = "D:\Temp\" ' pfad anpassen
    .SearchSubFolders = True
    .Filename = "*.txt"
    .MatchTextExactly = True
    .FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
zeile = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1 ' tabellennamen anpassen
If .Execute() > 0 Then
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + "D:\Temp\" + DateiName, Destination:=Range("A" & zeile)) ' pfad anpassen
    .Name = "ob1201_2" 'ab hier deine importdaten
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlWindows
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
    .Refresh BackgroundQuery:=False 'ende importdaten
End With
End If
Next Dateien
End If
End With
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

hi daniel :-)

und noch ein fehler,kommt von dem ewigen kopieren und pasten,bei neu schreiben waere das nicht passiert grrr
alle guten dinge sind drei :-(

gruss nighty

Option Explicit
Sub FilesListen()
Call EventsOff
Dim Dateien As Integer
Dim DateiName As String
Dim zeile As Long
With Application.FileSearch
.NewSearch
.LookIn = "D:\Temp\" ' pfad anpassen
.SearchSubFolders = True
.Filename = "*.txt"
.MatchTextExactly = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For Dateien = 1 To .FoundFiles.Count
DateiName = Dir(.FoundFiles(Dateien))
zeile = ThisWorkbook.Sheets("Tabelle1").Cells(Rows.Count, 1).End(xlUp).Row + 1 ' tabellennamen anpassen
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" + "D:\Temp\" + DateiName, Destination:=Range("A" & zeile)) ' pfad anpassen
.Name = "ob1201_2" 'ab hier deine importdaten
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.Refresh BackgroundQuery:=False 'ende importdaten
End With
Next Dateien
End If
End With
Call EventsOn
End Sub

Public Sub EventsOff()
With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
End Sub

Public Sub EventsOn()
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

Hallo,

vielen Dank für deine Mühe !!!!

Das Programm geht super!

Allerdings habe ich eine Liste in Excel wo alle Adressen drin stehen. z.b.: "c/temp_werte/2005/November/20.txt"

Bisher habe ich mit der Hand alle Adressen kopiert und über Datei -> Öffnen in den Excel geöffnet.
Als nächstes habe ich die Adressen kopiert mit einen Script.

Geht das nicht mit einen Script zuöffnen die Datein - so wie eine schleife?

Danke schön :-)

Hallo schoolwork,

ich habe zwar nicht so ganz verstanden, was Du mit Deinem letzten Beitrag aussagen wolltest, aber ich habe Dir mal ein Makro erstellt, dass Dir alle Textdateien in einem bestimmten Verzeichnis öffnet, die darin enthaltenen Daten kopiert und diese dann untereinander in das 1. Tabellenblatt Deiner Datei einfügt. Den Zustand, wieviele Dateien bereits eingelesen wurden kannst Du am unteren Rand in der Statusleiste ersehen. Dort steht dann "Datei x von y bereits verarbeitet". Wenn alles beendet ist, sind alle Daten der Textdateien in einem Tabellenblatt zusammengefasst.
Kopiere das Makro in ein StandardModul.

[b]Option Explicit
Const Verzeichnis = "C:\Temp\"

Sub Alle_Textdateien_einlesen()
Dim Datei As String
Dim Dateityp$
Dim lastRow As Integer
Dim FirstFreeCell As Integer
Dim Zähler As Integer, Zähler1 As Integer
Application.ScreenUpdating = False
Dateityp = Dir(Verzeichnis & "\*.txt")
Do While Dateityp <> ""
Zähler = Zähler + 1
Dateityp = Dir
Loop
FirstFreeCell = 1
Application.DisplayAlerts = False
Dateityp = Dir(Verzeichnis & "\*.txt")
'Prüfen ob sich Dateien im Verzeichnis befinden
Do While Dateityp <> ""
Zähler1 = Zähler1 + 1
Application.StatusBar = "Datei " & Zähler1 & " von " & Zähler & " bereits verarbeitet"
Workbooks.OpenText Filename:=Verzeichnis & Dateityp, Comma:=True
With Workbooks(Dateityp)
lastRow = .Sheets(1).UsedRange.Rows.Count
.Sheets(1).Range("A1:IV" & lastRow).Copy
ThisWorkbook.Sheets(1).Cells(FirstFreeCell, 1).PasteSpecial
.Close
End With
Dateityp = Dir
FirstFreeCell = ThisWorkbook.Sheets(1).Range("A65536").End(xlUp).Offset(1, 0).Row
Loop
Application.DisplayAlerts = True
End Sub[/b]

Du musst in dem Makro in der Zeile

[b]Const Verzeichnis = "C:\Temp\"[/b]

den Pfad noch anpassen. Du musst dort den Pfad hinschreiben, in dem sich Deine 2000 Textdateien befinden.

Ich hoffe, Du meintest das so. Wenn nicht, musst Du etwas genauer werden.

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,

wundert euch nicht das ich mich erst jetzt melde, ich war im Urlaub :-) !

@ coros und die anderen viieeeeeeelen Dank für das Marko funzt super !!!

Eine Sache habe ich noch wo ich nicht weiter komme :(
Ich habe eine Excel-Datei mit lauter Dateinamen z.b. C:/wetter/wetter_02.02.99.txt. Die geht von A1 bis A256!

Wenn ich jetzt in Excel ein Marko anlege kommt das:
Sub blabla...
Range("A1").Select
Workbooks.Open Filename:= _
"C:/wetter/wetter_02.02.99.txt"

Was muss ich da eintragen das dass so geht:
Sub blabla...
Range("A1").Select
Workbooks.Open Filename:= _
"RangeA1:A256.Select"

Ich möchte das nacheinander alle Datein die in der Liste strehen geöffnet werden. Ein Marko bearbeitet dann die Datei.

Kann mir da jemand weiter helfen?

Danke schön!

Daniel

Hallo Daniel,

für Dein Vorhaben würde die Schleife folgendermaßem aussehen:

[b]Dim i As Integer
For i = 1 To 256
Workbooks.Open Filename:=Cells(i, 1)
'.... hier dann weiterer VBA-Code, ....
'.... der die Datei bearbeitet ....
Next[/b]

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

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.}

hi@ll,

vielen dank hat alles super geklappt ;)

allen noch einen schönen tag...