CSV-Dateien mit VBA einlesen

Hallo VBA-Freunde,
gestern habe ich fast den ganzen Tag gesucht und ausprobiert, aber keine Lösung für meine Problemstellung gefunden (bzw. war ich nicht in der Lage, eine vorhandene Lösung umzubauen, dass sie lief):
In einem Verzeichnis stehen viele CSV-Dateien. Die Daten sind mit Komma getrennt.
Diese möchte ich in eine Excel-Tabelle einlesen:
In die erste Spalte soll in jede Zeile der Dateiname geschrieben werden. In die weiteren Spalten und Zeilen dann die Daten. Eine Kommatrennung entspricht dann einer neuen Spalte.
Die Daten der nächsten Datei soll einfach unter die vorherige angefügt werden.
Habe schon versucht, das als Makro aufzuzeichnen und den Dateinamen variabel zu machen, bin aber gescheitert:
Dim Pfad As String
Dim Datei As String
Dim i As Integer
Dim alt As Variant, neu As Variant
With Application.FileSearch
.LookIn = "K:\Testverzeichnis\"
.Filename = "*.CSV"
If .Execute > 0 Then
For i = 1 To .FoundFiles.Count
alt = .FoundFiles(i)
neu = Mid(.FoundFiles(i), 66)
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;K:\Testverzeichnis\" _
& neu, Destination:=Selection)
' im aufgezeichneten Code steht hier der ganze Verzeichnis- und
' Dateiname. Ich habe versucht, dies variabel zu gestalten
.Name = neu
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 1252
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
' .Refresh BackgroundQuery:=False
End With
Cells(64000, 1).End(xlUp).Select
Next i
End If
End With
End Sub
Hat von euch schon mal wer so eine Lösung erarbeitet? Könnte mir da jemand weiterhelfen?
Danke im Voraus,
Stefan

Hallo Heiko,
vielen Dank für deine Hilfe, der Code funktioniert super! Das erspart eine Menge Arbeit.
Ein klein wenig habe ich ihn abgeändert, weil ich die Dateinamen links neben der ersten CSV-Zeile haben möchte:

Sub CSV_Import()
Dim strPfad As String
Dim lngLastRow As Long
Dim myFileSystemObject, myFiles
' Pfad hier anpassen
strPfad = "K:\Stoffverbote\Stoffinformationen Zulierferware\test umbenennen\"
Set myFileSystemObject = CreateObject("Scripting.FileSystemObject")
For Each myFiles In myFileSystemObject.GetFolder(strPfad).Files
If InStr(UCase(myFiles), ".CSV") Then
lngLastRow = ActiveSheet.Cells(65535, 2).End(xlUp).Row
ActiveSheet.Cells(lngLastRow + 1, 1) = myFiles
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & myFiles, Destination:=Range(Cells(lngLastRow + 1, 2), Cells(lngLastRow +  _
1, 2)))
.Name = myFiles
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
Next myFiles
End Sub

Ich muss mir noch eine Routine bauen, um das Verzeichnis und die Endung zu entfernen und den verbleibenden Text in die leerzellen zu schreiben.
Viele Grüße
Stefan

Forumthread: CSV-Dateien mit VBA einlesen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial