Mittels VBA verschiedene CSV's in Ordnern und Unterordner auslesen

DominikLinauer · 19. November 2019

Hallo!

Hab eine etwas speziellere Frage.

Ich bekomm mehrere CSV's welche gleich aufgebaut sind und mittels Semikolon getrennt sind.

Jetzt brauch ich von diesen CSV's jeweils den Dateinamen und zusätzlich den ersten und den letzten Eintrag der Spalte C.

Die Anzahl ist immer variable also müsste VBA selbst erkennen welche die letzte gefüllte Zeile ist.

Ich hab es bis jetzt nur geschafft alle Dateinamen aus den Ordnern und Unterordnern aufzulisten.

Leider nicht diese zu öffnen und mir den ersten Wert und den letzten Wert wiederzugeben.

Danke!

Untenstehend der aktuelle Code

Sub DateienMitUnterordnernAuflisten()

Dim lngZeile As Long
Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objDateienliste As Object
Dim objDatei As Object

Set objFileSystem = CreateObject("scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.getfolder("PFAD")
Set objDateienliste = objVerzeichnis.Files

lngZeile = 1

For Each objDatei In objDateienliste
If Not objDatei Is Nothing Then
ActiveSheet.Cells(lngZeile, 1) = objDatei.Name
lngZeile = lngZeile + 1
End If
Next objDatei

Call UnterOrdnerAuslesen(objVerzeichnis)

End Sub

Sub UnterOrdnerAuslesen(ByVal strDateipfad As String)

Dim objFileSystem As Object
Dim objVerzeichnis As Object
Dim objUnterordner As Object
Dim objDatei As Object
Dim i As Long

Set objFileSystem = CreateObject("Scripting.FileSystemObject")
Set objVerzeichnis = objFileSystem.getfolder(strDateipfad)

If Cells(Rows.Count, 1).End(xlUp).Row >= 1 Then
i = Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
i = 1
End If

For Each objUnterordner In objVerzeichnis.subfolders
For Each objDatei In objUnterordner.Files
If Not objDatei Is Nothing Then
ActiveSheet.Cells(i, 1) = objDatei.Name
i = i + 1
End If
Next objDatei

Next objUnterordner

End Sub

Andreas Killer

Ich denke so sollte es auch gehen, ist etwas einfacher.

Andreas.

Sub Update()

  Dim FS As New FileSearch

  Dim ff As Integer

  Dim Contents As String

  Dim FName, Data, Lines, Part

  Dim i As Long

  Dim Dict As Object 'Scripting.Dictionary

  Dim R As Range

  Dim NewFiles As New Collection

  

  Set Dict = CreateObject("Scripting.Dictionary")

  Dict.CompareMode = vbTextCompare

  For Each R In Range("A2", Range("A" & Rows.Count).End(xlUp))

    FName = R.Value

    If Not Dict.Exists(FName) Then Dict.Add FName, 0

  Next

 

  With FS

    'Dateien suchen

    .LookIn = ThisWorkbook.Path

    .FileName = "*.csv"

    .SearchSubFolders = True

    .Execute

   

    If .FoundFiles.Count = 0 Then

      MsgBox "Keine Dateien gefunden"

      Exit Sub

    End If

    

    For Each FName In .FoundFiles

      Part = Mid(FName, InStrRev(FName, "\") + 1)

      If Not Dict.Exists(Part) Then NewFiles.Add FName

    Next

    

    If NewFiles.Count = 0 Then

      MsgBox "Keine Dateien gefunden"

      Exit Sub

    End If

    Set .FoundFiles = NewFiles

   

    'Ausgabe vorbereiten

    ReDim Data(1 To .FoundFiles.Count, 1 To 3)

   

    For Each FName In .FoundFiles

      'Dateiname speichern

      i = i + 1

      Data(i, 1) = FName

     

      'Datei einlesen

      ff = FreeFile

      Open FName For Binary Access Read Lock Write As #ff

      Contents = Space(LOF(ff))

      Get #ff, , Contents

      Close #ff

      'Zeilen trennen

      Lines = Split(Contents, vbCrLf)

      'Erster Wert in 3ter Spalte

      Part = Split(Lines(0), ";")

      If UBound(Part) < 2 Then

        Data(i, 2) = "-"

      Else

        Data(i, 2) = Part(2)

      End If

      'Letzter Wert in 3ter Spalte

      Part = Split(Lines(UBound(Lines)), ";")

      If UBound(Part) < 2 Then

        Data(i, 3) = "-"

      Else

        Data(i, 3) = Part(2)

      End If

    Next

  End With

  'Ausgeben

  Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(Data), UBound(Data, 2)).Value = Data

End Sub

Andreas Killer

Wäre es nun möglich meine Tabelle vorher mit meiner Excel abzugleichen und nur neue Dateien in der Tabelle anfügen und nicht mehr vorhandene Dateien trotzdem in der Excel bestehen zu lassen und nicht zu löschen?

Naja, würde schon gehen.

Dazu müssen jedoch den ganzen Code ablaufen lassen, außer der Ausgabe, und bekommen so ein Array NEU mit allen Dateien die da sind.

Nun müssen wir die vorhandenen Daten in ein Array ALT einlesen und dann müssen wir für jede Datei in NEU prüfen ob diese in ALT vorhanden ist, wenn nicht, dann die Daten aus NEU in ein Array HINZU übertragen.

Dieses HINZU können wir dann unter die Daten schreiben...

Andreas.

Andreas Killer

Vielen vielen Dank!

Funktioniert ohne Probleme

Ich freue mich das zu lesen. Markierst Du mir jetzt meinen Post mit dem Code als Antwort? .-)

Andreas.

DominikLinauer

Wäre es nun möglich meine Tabelle vorher mit meiner Excel abzugleichen und nur neue Dateien in der Tabelle anfügen und nicht mehr vorhandene Dateien trotzdem in der Excel bestehen zu lassen und nicht zu löschen?

Naja, würde schon gehen.

Dazu müssen jedoch den ganzen Code ablaufen lassen, außer der Ausgabe, und bekommen so ein Array NEU mit allen Dateien die da sind.

Nun müssen wir die vorhandenen Daten in ein Array ALT einlesen und dann müssen wir für jede Datei in NEU prüfen ob diese in ALT vorhanden ist, wenn nicht, dann die Daten aus NEU in ein Array HINZU übertragen.

Dieses HINZU können wir dann unter die Daten schreiben...

Andreas.

Könnten Sie mir hierbei noch behilflich sein?

Mein Code Sieht einstweilen so aus:

Sub Test()

Dim FS As New FileSearch

Dim ff As Integer

Dim Contents As String

Dim FName, Data, Lines, Part

Dim i As Long

Dim Zeilenanzahl As Long

With FS

'Dateien suchen

.LookIn = "PFAD"

.FileName = "*.csv"

.SearchSubFolders = True

.Execute

If .FoundFiles.Count = 0 Then

MsgBox "Keine Dateien gefunden"

Exit Sub

End If

'Ausgabe vorbereiten

ReDim Data(1 To .FoundFiles.Count, 1 To 3)

For Each FName In .FoundFiles

'Dateiname speichern

i = i + 1

Data(i, 1) = Mid(FName, InStrRev(FName, "\") + 1)

'Datei einlesen

ff = FreeFile

Open FName For Binary Access Read Lock Write As #ff

Contents = Space(LOF(ff))

Get #ff, , Contents

Close #ff

'Zeilen trennen

Lines = Split(Contents, vbCrLf)

'Erster Wert in 3ter Spalte

Part = Split(Lines(1), ";")

If UBound(Part) < 2 Then

Data(i, 2) = "-"

Else

Data(i, 2) = Part(6)

End If

'Letzter Wert in 3ter Spalte

Part = Split(Lines(UBound(Lines)), ";")

If UBound(Part) < 2 Then

Data(i, 3) = "-"

Else

Data(i, 3) = Part(6)

End If

Next

End With

'Ausgeben

Range("A1:C1") = Array("Datei", "Erster", "Letzter")

Range("A2").Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data

End Sub

Andreas Killer

Da stimme ich dir grundsätzlich zu aber in diesem Fall wird die Info nicht benötigt da man aus dem Dateinamen gezielte Werte braucht.

Okay, also Thread beantwortet? Würdest Du den Post mit dem Code bitte als Antwort markieren? Danke.

Hi,

willkommen im Windows Forum!

Mittels VBA verschiedene CSV's in Ordnern und Unterordner auslesen - Similar Threads - Mittels VBA verschiedene	Forum	Datum
Wie kann man in SharePoint nur innerhalb eines Unterordners das Teilen mittels Link zu... Wie kann man in SharePoint nur innerhalb eines Unterordners das Teilen mittels Link zu...: Innerhalb unsere Unternehmens möchten wir die Vergabe von individuellen Berechtigungen in SharePoint über Personen und Links unterbinden und stattdessen über Gruppen organisieren. Wegen sehr hoher...	Microsoft Office	1. Oktober 2024
Daten zusammenfassen mittels VBA Daten zusammenfassen mittels VBA: Hallo zusammen,ich habe ein Excel mit verschiedenen Reitern. Die Reiter haben als Namen die Kundennummer und den Kundennamen. Jeder Reiter hat den selben Aufbau: ID, Rechnungsnummer,...	Microsoft Office	25. Juni 2024
E-Mails suchen und filtern, die in verschiedenen Ordnern / Unterordnern liegen E-Mails suchen und filtern, die in verschiedenen Ordnern / Unterordnern liegen: HalloWir sortieren empfangene und gesendete E-Mails in unserem gemeinsam genutzten Postfach in verschiedenste Ordner und Unterordner ein.Wie kann ich E-Mails suchen, die nicht nach Inhalten...	Outlook.com	20. September 2023
Webseite mit VBA unter Google Chrome auslesen Webseite mit VBA unter Google Chrome auslesen: Hallo zusammen, bisher rufe ich per VBA eine Webseite im IE auf und schreibe die Daten zur weiteren Verarbeitung in ein Tabellenblatt. Nun wird der Chrome bei uns der Standardbrowser und ich weiß...	Microsoft Office	16. September 2019
Ordner / Unterordner Ordner / Unterordner: Hallo, wenn ich meinen Email Eingang auf outlook.com umstelle, kann ich dann unbegrenzt Ordner / Unterordner anlegen? Ich benötige mehr als 100 Ordner. Gruß Helga	Outlook.com	15. April 2018
Ordner und Unterordner erstellen Ordner und Unterordner erstellen: Hallo, vermutlich nach einem Update von Microsoft kann ich keine Ordner und Unterordner mehr erstellen. Diese Kern-Funktion möchte ich schnellstens wieder herstellen. Was muss ich tun damit...	Windows Insider	16. Oktober 2017
Excel VBA Textzeile aus Webseite auslesen Excel VBA Textzeile aus Webseite auslesen: HI! Ich würde gerne von einer Webseite: http://logik.phl.univie.ac.at/~chris/gateway/formular-zentral.html nur EINE Textzeile (mit der Lösung) in EINE Excelzelle auslesen lassen. Zuvor will...	Microsoft Office	21. Dezember 2016

Mittels VBA verschiedene CSV's in Ordnern und Unterordner auslesen