AW: Alle txt File aus Ordner einlesen
27.07.2007 23:31:00
Ramses
Hallo
das kommt nicht klar raus:
Wie stehen die Daten im Textfile ?
Gibt es ein klares Trennzeichen der Datenfelder, z.B. das ";" oder ein "," ?
Dieser Code macht mal das was du willst
Option Explicit
Sub Read_Text_Files_from_Folder()
'(C) Ramses
Const OpenFileForReading = 1
Dim myFSO As Object, myFSOImp As Object
Dim myImpFiles As Object, myImpFile As Object, myFile As Object
Dim myImpFolder As String, tmpImp As String
Dim i As Long, txtLines As Long
Dim Suchdialog As FileDialog
Dim myImpWKB As Workbook, myImpWKS As Worksheet
'********************************
'Nichts mehr ändern
Set Suchdialog = Application.FileDialog(msoFileDialogFolderPicker)
'Dialog für EXCEL XP und höher
'Auswählen wo die TEXT-Dateien liegen
With Suchdialog
.Title = "Bitte wählen Sie ein Verzeichnis aus"
'Environ(25) ermittelt den Aktuellen Userpfad
.InitialFileName = Environ(25) & "\Eigene Dateien\"
.ButtonName = "Auswahl übernehmen"
.Show
If .SelectedItems.Count = 0 Then
MsgBox "Sie haben kein Verzeichnis ausgewählt", vbInformation
Set Suchdialog = Nothing
Exit Sub
Else
myImpFolder = .SelectedItems(1)
MsgBox myImpFolder
End If
End With
Set myImpWKB = Workbooks.Add
With myImpWKB
For i = .Worksheets.Count To 2 Step -1
Application.DisplayAlerts = False
.Worksheets(i).Delete
Application.DisplayAlerts = True
Next i
Set myImpWKS = .Worksheets(1)
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set myFSOImp = myFSO.GetFolder(myImpFolder)
Set myImpFiles = myFSOImp.Files
For Each myImpFile In myImpFiles
If Right(myImpFile, 3) = "txt" Then
Set myFile = myFSO.getfile(myImpFile)
Open myFile For Input As #1
txtLines = 1
With myImpWKS
.Move after:=Worksheets(Worksheets.Count)
Do While Not EOF(1) ' Schleife bis Dateiende.
Input #1, tmpImp
'Zähler hochzählen
.Cells(txtLines, 1) = tmpImp
txtLines = txtLines + 1
Loop
'Import Text auf Spalten aufteilen
.Columns(1).TextToColumns Destination:=Range("A1"), _
DataType:=xlDelimited, _
Semicolon:=True
'oder
'Comma:=True
'Tab:=True
'Space:=True
'Name der Tabelle entweder der ImportFile Name
.Name = Right(myFile, Len(myFile) - InStrRev(myFile, "\", -1))
'oder der Name aus Zelle 1
'.Name = .Cells(1, 1)
End With
Close #1
Set myImpWKS = .Worksheets.Add
End If
Next
End With
End Sub
.... allerdings ohne das XY-Diagramm.
Aber das erstellen kannst du mit dem Makrorekorder ja aufzeichnen
Gruss Rainer