Alle CSV Daten eines Ordners einlesen

Hallo zusammen,
ich versuche ein Makro zu schreiben, welches mir alle CSV Dateien eines Ordners wieder gibt. Dabei möchte ich nur den Ordner wählen und nicht per Multiselect alle vorhandenen Dateien. das würde mir schon sehr helfen.
Idellerweise sollte der Pfad mit Thisworkbook.Path abgegriffen werden und durch die Unterverzeichnisse z.B. SPOS erweitert werden, so dass ich das Makro starten und alles automatisiert abläuft.
Das Makro was ich bereits habe funktioniert, aber eben die manueller Auswahl alles csv.
Gruß und Dank vorab
Mesel

Sub FLD()
Dim file
Dim dat
Dim bolOeffnen As Boolean
Set dat = Application.FileDialog(msoFileDialogFilePicker)
ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
With dat
.Title = "Daten auswählen...."
.InitialFileName = "" 'oder was auch immer
.AllowMultiSelect = True 'Man kann mit gedrückter Strg-Taste mehrere Dateien auswählen
.Filters.Clear
.Filters.Add "CSV", "*.CSV"
bolOeffnen = .Show
If bolOeffnen = True Then 'Es wurde etwas ausgewählt
For Each file In .SelectedItems 'Schleife über alle ausgewählten Dateien
Application.ScreenUpdating = False
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & file, Destination:=Range( _
"A61"))
.Name = "FLD"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Application.ScreenUpdating = True
Next file
Else:
'MsgBox "Es wurde nichts ausgewählt und ""Abbrechen"" geklickt!"
End If
End With
End Sub

Office 2010
Win 7 / Linux Redhat 5

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Arthur,
danke für deine Antwort.
Das hatte ich versucht und konnte eben keinen Filter mehr benutzen und bei .Refresh BackgroundQuery:=False kommt der Debuuger Laufzeitfehler 1004 "....Textdatei kann nicht gefunden werden...". Oder muss ich noch andere Änderungen durchführen.
Den 2. Schritt verstehe ich, sorry aber diese Pfad und Dateienausleserei ist noch Neuland für mich.
Besser wäre so etwas wie ThisWorkbook.Path + Unterverzeichniss zu haben und garnicht erst wählen zu müssen, welchen Pfad man haben möchte.
Hintergrund: Ich lese die Daten aus einer Simulation aus, es entstehen dadurch immer 2 Unterverzeichnisse mit x csv Dateien. Die Unterverzeichnisse heißen immer SPOS und SNEG, z.B.: G:\FLD\SPOS, mein Sheet ist auf G:\FLD.
Gruß und Dank
Mesel

Sub FLD_All() Dim strFolder As String Dim strFile As String ChDrive ThisWorkbook.Path ChDir ThisWorkbook.Path strFolder = ThisWorkbook.Path & "\SPOS" MsgBox strFolder strFile = Dir(strFolder & "*.csv") MsgBox strFile While Len(strFile) > 0 Application.ScreenUpdating = False With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & strFolder & strFile, Destination:=Range( _ "A61")) .Name = "FLD" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With Application.ScreenUpdating = True strFile = Dir 'Application.Wait (Now + TimeValue("0:00:01")) Wend End Sub

Sub FLD_All_in_SPOS() Dim zeile As Variant Dim sFile As String, sPattern As String, sPath As String Dim iRow As Integer iRow = 3 Cells(3, 3).ClearContents sPath = ThisWorkbook.Path & "\SPOS" ' Hier gibst Du Deinen Pfand zum gewünschten Verzeichnis _ an If Right(sPath, 1) "\" Then sPath = sPath & "\" sPattern = "*.*" sFile = Dir(sPath & sPattern) MsgBox sFile & sPath Do Until sFile = "" Application.ScreenUpdating = False With ActiveSheet.QueryTables.Add(Connection:= _ "TEXT;" & sFile, Destination:=Range( _ "A61")) .Name = "FLD" .FieldNames = True .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .RefreshStyle = xlOverwriteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = False .RefreshPeriod = 0 .TextFilePromptOnRefresh = False .TextFilePlatform = 850 .TextFileStartRow = 1 .TextFileParseType = xlDelimited .TextFileTextQualifier = xlTextQualifierDoubleQuote .TextFileConsecutiveDelimiter = False .TextFileTabDelimiter = True .TextFileSemicolonDelimiter = False .TextFileCommaDelimiter = False .TextFileSpaceDelimiter = True .TextFileColumnDataTypes = Array(1, 1) .TextFileTrailingMinusNumbers = True .Refresh BackgroundQuery:=False End With ActiveSheet.QueryTables(1).Delete Application.ScreenUpdating = True 'Application.Wait (Now + TimeValue("0:00:01")) ' iRow = iRow + 1 ' Cells(iRow, 22).Value = sPath & sFile Cells(iRow, 3).Value = sFile sFile = Dir() Loop For zeile = 1 To Cells.SpecialCells(xlLastCell).Row Next End Sub

Beliebteste Forumthreads (12 Monate)

Alle CSV Daten eines Ordners einlesen

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

228 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Alle CSV Daten eines Ordners einlesen

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

228 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread