Daten Import aus mehreren csv Dateien

Hallo,
ich stecke noch ziemlich in den Anfängen was die VBA Programmierung betrifft und hoffe ihr könnt mir mit euren fundierten wissen weiterhelfen.

Folgende Aufgabenstellung:
Es werden Messwerte von unseren Produkten in csv Dateien abgespeichert in einem Ordner auf dem Server. Ich möchte jetzt aus diesen csv Dateien alle Werte zusammenfassen in eine Excel Tabelle.
In dieser csv Datei werden die ersten 3 Zeilen beschrieben. Ich benötige aber nur die Werte aus Zeile drei. Diese Werte sollen dann in der Excel Tabelle ab Zeile 2 eingefügt werden. Dass ganze soll mit einem klick auf einem Butten täglich aktualisiert werden.
Ich habe schon etwas das vom Prinzip her so funktioniert wie ich das gerne hätte. Nur schaffe ich es nicht das aus jeder csv Datei nur die dritte Zeile Importiert wird. Es werden immer alle Daten Importiert.

Sub Daten_Import_csv()

Dim Datei As String, freeRow As Long
Dim Qe As Integer
Dim PFAD As String
PFAD = "S:\Austausch\Guth\VBA Test\Messdaten_test\"
Datei = Dir(PFAD & "*.csv")

Do While Datei <> ""
freeRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & PFAD & Datei, Destination:=Range("A" & freeRow))
.Name = Datei
.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 = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Datei = Dir()
Loop
End Sub

Danke schonmal für eure Hilfe

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 561959

Url: https://administrator.de/forum/daten-import-aus-mehreren-csv-dateien-561959.html

Ausgedruckt am: 21.04.2025 um 16:04 Uhr

2 Kommentare

Neuester Kommentar

Würde das zwar heutzutage mit nem Powershell Einzeiler abfackeln aber naja, jeder wie er will und kann

gci "S:\Austausch\Guth\VBA Test\Messdaten_test" -Filter *.csv -File | %{Import-csv $_.Fullname -Delimiter ";" | select -Index 1} | export-csv .\zusammenfassung.csv -Delimiter ";" -NoType -Encoding UTF8  

Für VBA guck doch mal in diesen Thread
Excel Makro um CSV Dateien auszuwerten und gesammelt anzuzeigen.

Hier mal auf die Schnelle der angepasste Code von dem Thread der jeweils nur die Zeile 3 jeder CSV kopiert

Sub ImportCSVFromFolder()
    Dim wsTemp As Worksheet, wsTarget As Worksheet, curCell As Range, CSVPFAD As String, fso As Object, f As Object, strCSVDelimiter As String
    
    CSVPFAD = "S:\Austausch\Guth\VBA Test\Messdaten_test"  
 
    'Legt das CSV-Trennzeichen für die Dateien fest  
    strCSVDelimiter = ";"  
    
    Set fso = CreateObject("Scripting.Filesystemobject")  
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Zielarbeitsblatt für die importierten Daten  
    Set wsTarget = Worksheets(1)
    'temporäres Arbeitsblatt für den Import der Daten erstellen  
    Set wsTemp = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    
    'Inhalt des Zusammenfassungsblattes löschen  
    wsTarget.UsedRange.Offset(1, 0).Clear
    
    'Startausgabezelle festlegen  
    Set curCell = wsTarget.Range("A2")  
    For Each f In fso.GetFolder(CSVPFAD).Files
        If LCase(fso.GetExtensionName(f.Name)) = "csv" Then  
            'Temporäres Sheet löschen  
            wsTemp.UsedRange.Clear
            'CSV-Daten in Temporäres Sheet importieren  
            With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f.Path, Destination:=wsTemp.Range("$A$1"))  
                .Name = "import"  
                .FieldNames = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                .TextFileParseType = xlDelimited
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileOtherDelimiter = strCSVDelimiter
                .Refresh BackgroundQuery:=False
                .Delete
            End With
            
            With wsTemp
                'Daten von Zeile 3 in Zielsheet kopieren  
                .Rows(3).Copy curCell
            End With
            'Ausgabezeile eins nach unten schieben  
            Set curCell = curCell.Offset(1, 0)
        End If
    Next
    'Temporäres Sheet löschen  
    wsTemp.Delete
    'Spalten anpassen  
    wsTarget.Columns.AutoFit
    wsTarget.Activate
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    MsgBox "Vorgang beendet!", vbInformation  
    Set fso = Nothing
End Sub