mtufangil
Goto Top

Mehrere CSV Dateien aus verschiedenen Ordner einlesen via VBA

Hallo Zusammen,

ich bin ein absoluter VBA Neuling und versuche etwas umzusetzen, leider komme ich nicht weiter.
Ich hoffe ihr könnt mir helfen.

Ich habe mehre Ordner, indem sich mehrere CSV Dateien befinden.
Bsp.:
CSV_ORDNER:
Ordner1 : 1.csv 2.csv
Ordner2: 3.csv 4csv

Diese CSV Dateien sollen in eine Excel Tabelle geschrieben werden.
Jeder Ordner soll einen eigenen Tabellen Namen haben, aber den Ordner Namen besitzen.
Bei der ersten CSV Datei soll die erste Zeile als Überschrift berücksichtigt werden und ab der zweiten CSV soll der Import ab der zweiten Zeile beginnen.
Die CSV Dateien sind Komma getrennt.
Das ganze Spiel dann wieder Ordner für Ordner.

Ich danke schon mal!

Beste Grüße!

Content-Key: 317423

Url: https://administrator.de/contentid/317423

Ausgedruckt am: 19.03.2024 um 09:03 Uhr

Mitglied: 131026
131026 11.10.2016 aktualisiert um 10:17:13 Uhr
Goto Top
Suche benutzen face-wink
Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen Teil 2
Alle CSV-Dateien in einem Ordner mit einem VBA Makro einlesen
Excel Makro um CSV Dateien auszuwerten und gesammelt anzuzeigen.
ich bin ein absoluter VBA Neuling
Dann übe erst noch was face-smile Das ist hier ja ein Administrator-Forum, kein Programmierkurs für Anfänger.

R.
Mitglied: colinardo
Lösung colinardo 12.10.2016, aktualisiert am 13.10.2016 um 08:18:44 Uhr
Goto Top
Hallo @mutfangil, willkommen auf Administrator.de!
Eigentlich bieten die von @131026 geposteten Beiträge von mir eine Steilvorlage für dein Vorhaben. Aber da diese Fragen hier im Forum anscheinend öfters angeklickt werden werde ich nochmal eine Lösung für dein Vorhaben posten.

Der Code unten ist zur Verwendung innerhalb von Excel (VBA).

Kommentare siehe Code
Dim fso As Object

Sub ImportCSVtoFolderGroups()
    Dim dic As Object, file As Variant, strFolderBaseName As String, ws As Worksheet, isFirst As Boolean, rngNext As Range, ROOTFOLDER As Variant, lngEncoding As Long, keys As Variant, i As Long
    
    ' Ordner per Dialog wählen  
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Ordner wählen der die Ordner der CSV-Dateien enthält"  
        .AllowMultiSelect = False
        .ButtonName = "Ordner wählen ..."  
        .InitialView = msoFileDialogViewList
        If .Show = -1 Then
            ROOTFOLDER = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With
    
    ' Encoding Abfrage  
    lngEncoding = IIf(MsgBox("Liegen die CSV-Dateien im 'UTF8'-Encoding vor?" & vbNewLine & "(Bei 'Nein' wird ANSI verwendet)", vbYesNo Or vbQuestion, "Encoding der CSV-Dateien festlegen") = vbYes, 65001, 1252)  
    
    ' Screenrefresh der Performance wegen deaktiveren  
    Application.ScreenUpdating = False
    
    ' Objekte erstellen  
    Set fso = CreateObject("Scripting.FileSystemObject")  
    Set dic = CreateObject("Scripting.Dictionary")  
    
    ' Dateien rekursiv in Dictionary einlesen  
    GetFileGroups fso.GetFolder(ROOTFOLDER), True, dic, "csv"  
    
    'Ordnernamen  
    keys = dic.keys()
    ' Für jeden Ordner im Dictionary  
    For i = 0 To dic.Count - 1
        'Basisname des Ordners extrahieren  
        strFolderBaseName = fso.GetBaseName(keys(i))
        On Error Resume Next
        ' Sheet setzen  
        Set ws = Worksheets(strFolderBaseName)
        ' Sheet existiert noch nicht lege neues an  
        If Err.Number <> 0 Then
            Set ws = Worksheets.Add(After:=Sheets(Sheets.Count))
            ws.Name = strFolderBaseName
            ' Setze Zielbereich für Import  
            Set rngNext = ws.Range("A1")  
            isFirst = True
            Err.Clear
            On Error GoTo 0
        End If
        With ws
            ' Für jede CSV des Ordners  
            For Each file In Split(dic.Item(keys(i)), "|", -1, vbTextCompare)  
                ' Setze Zielbereich für Import auf nächste leere Zeile  
                Set rngNext = .Range("A" & .UsedRange.SpecialCells(xlCellTypeLastCell).Row + IIf(isFirst, 0, 1))  
                
                ' Import der CSV-Daten  
                With .QueryTables.Add(Connection:="TEXT;" & file, Destination:=rngNext)  
                    .Name = "import"  
                    .FieldNames = True  'CSV hat Überschriften  
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .TextFilePlatform = lngEncoding   'unicode = 65001 / ANSI = 1252  
                    .TextFileStartRow = IIf(isFirst, 1, 2)  'Überspringe die Überschriftenzeile  
                    .TextFileParseType = xlDelimited
                    .TextFileTextQualifier = xlTextQualifierDoubleQuote
                    .TextFileCommaDelimiter = True  'Komma ist der Delimiter  
                    .Refresh BackgroundQuery:=False
                    .Delete
                End With
                isFirst = False
            Next
            'Spaltenbreite anpassen  
            .UsedRange.EntireColumn.AutoFit
            ' Überschriften Fett machen  
            .Range("1:1").Font.Bold = True  
        End With
        
    Next
    ' Screenrefresh wieder aktivieren  
    Application.ScreenUpdating = True
    'Meldung ausgeben  
    MsgBox "Fertig", vbInformation  
    'Cleanup  
    Set fso = Nothing
    Set dic = Nothing
End Sub

'Funktion die Ordner-Gruppen rekursiv in ein Dictionary einliest  
Function GetFileGroups(ByVal fldr As Object, ByVal boolRecurse, ByRef dic As Object, ByVal strExtension As String)
    Dim file As Object, subfolder As Object
    For Each file In fldr.files
        If LCase(fso.GetExtensionName(file.Name)) = LCase(strExtension) And file.Size > 0 Then
            If dic.Exists(fldr.Path) Then
                dic.Item(fldr.Path) = dic.Item(fldr.Path) & "|" & file.Path  
            Else
                dic.Add fldr.Path, file.Path
            End If
        End If
    Next
    If boolRecurse Then
        For Each subfolder In fldr.SubFolders
            GetFileGroups subfolder, True, dic, strExtension
        Next
    End If
End Function
Grüße Uwe
Mitglied: mtufangil
mtufangil 12.10.2016 um 20:31:01 Uhr
Goto Top
Hallo Uwe,

danke für deine Mühe!!
Ich habe jetzt folgendes Problem.

Sobald er den erst Ordner abgearbeitet hat und mit dem zweiten Ordner anfangen sollte, erscheint die Fehlermeldung (Nicht genügend Speicher).

Grüße und noch mal danke!
Mert
Mitglied: colinardo
colinardo 12.10.2016 aktualisiert um 21:54:46 Uhr
Goto Top
  • Von wieviel CSV Dateien und Ordnern reden wir hier?
  • Welche Office Version und OS verwendest du ?
  • Welches Encoding besitzen die Dateien und wie groß sind diese im Durchschnitt (Anzahl Zeilen).
  • Wie sieht deine Ordnerstruktur genau aus? Irgendwelche Sonderzeichen im Pfad wie z.B. |?
  • Wie sehen die Specs deiner Hardware aus ?

Skript wurde hier mit 20 Testordnern die sich in einem Root-Ordner befinden
Root
|
|_Ordner 1
|        |_ datei1.csv
|        |_ datei2.csv
|
|_Ordner 2
|        |_ datei3.csv
|        |_ datei4.csv
|
|_Ordner 3
|        |_ datei5.csv
|        |_ datei6.csv
und 300 mit Zufallsdaten generierten CSV Dateien erfolgreich getestet.

Ich vermute bei dir eine beschädigte oder aus der Reihe stechende CSV Datei. Oder ein nicht erlaubtes Zeichen im Ordnernamen.

Steppe mit F8 durch den Code bis der Fehler auftritt, dann merke dir die Zeile.
Mitglied: mtufangil
mtufangil 12.10.2016 um 22:29:57 Uhr
Goto Top
Hier handelt es sich um 27 Ordnern.

Track1
Track2
..
Track27

CSV Datei:
sendname.csv (immer ohne Sonderzeichen)

In den Ordner befinden sich max 10 CSV Dateien.
Die Dateien besitzen das Encoding MS-DOS (PC-8).
Sonderzeichen sind keine vorhanden.

Windows 10 64Bit.
Excel 2016 32Bit
Intel Core i7 2,6 GHz; 16GB Arbeitsspeicher; 512GB SSD.

Maximale Anzahl der Zeilen einer CSV sind 20 Zeilen.
Die CSV Dateien haben 3 Spalten.

Beim Debuggen kam der Fehler beim ersten mal als er nach der Codierung fragt.
Egal ob ich mit ja oder nein bestätige der füllt die erste Tabelle und bricht ab.
Wenn ich mit der selben Tabelle weiter mache. Macht er dann mit Group10 weiter.
Group10 und Group11 füllt er vollständig.
Nachdem er die nächste Tabelle nach Group12 umbenennt, hängt er bei Zeile 68.
Mitglied: colinardo
Lösung colinardo 12.10.2016 aktualisiert um 23:57:24 Uhr
Goto Top
Zitat von @mtufangil:
In den Ordner befinden sich max 10 CSV Dateien.
Die Dateien besitzen das Encoding MS-DOS (PC-8).
Ok dann muss du das Encoding anpassen => Die Abfrage in Zeile 20 löschen und in Zeile 63 schreiben
.TextFilePlatform = xlMSDOS

Beim Debuggen kam der Fehler beim ersten mal als er nach der Codierung fragt.
Sehr ungewöhnlich, muss ein Bug in Excel 2016 mit der IIF() Funktion sein.

Wenn ich mit der selben Tabelle weiter mache. Macht er dann mit Group10 weiter.
Group10 und Group11 füllt er vollständig.
Was meinst du mit "Group" oben schreibst du das deine Ordner "Track1" "Track2" usw. lauten??
Nachdem er die nächste Tabelle nach Group12 umbenennt, hängt er bei Zeile 68.
Haben deine Ordner weitere Unterordner?
Welchen Ordner gibst du im Auswahldialog an? Du solltest dort den übergeordneten Ordner wählen indem sich deine "Track" Ordner befinden.

Ansonsten musst mir mal ein paar deiner CSV-Dateien per Download zur Verfügung stellen.
Hier läuft es auf der selben Platform mit Excel 2016 einwandfrei.
Benutzt du irgendwelche Excel-Addons?
Mitglied: 131026
131026 13.10.2016 um 00:01:16 Uhr
Goto Top
Zur Info: Hab das auch mal probiert und hier geht das Skript von @colinardo auch ohne Fehler durch. Wird wohl was an deinem System nicht i.O. sein oder einige der Dateien haben einen Schuss.

R.
Mitglied: mtufangil
mtufangil 13.10.2016 aktualisiert um 00:23:53 Uhr
Goto Top
Ich habe mal alle Addins deaktiviert. Ohne Erfolg.
Der Oberordner heißt track4. Dieser wird ausgewählt. Hab es gerade verwechselt.
Die Ordner heißen Group1, Group2, ..., Group27.

Ich werde in einer VM mal Office2013 installieren und es dort mal testen.
Wenn es dort auch nicht funktioniert, vermute ich auch, dass es an den CSV Dateien liegt.

Hab dir mal die Dateien hochgeladen und per PM geschickt.
Mitglied: mtufangil
mtufangil 13.10.2016 um 00:35:00 Uhr
Goto Top
Selber Fehler in der VM mit Office 2013.
Ich habe dir per PM die Daten zugeschickt.
Mitglied: colinardo
Lösung colinardo 13.10.2016 aktualisiert um 08:25:09 Uhr
Goto Top
Zitat von @mtufangil:
Ich habe dir per PM die Daten zugeschickt.
Klare Sache face-smile. Du hast in deinen Ordnern CSV-Dateien mit 0 Byte Größe die keinen Inhalt haben! Deswegen wird der Fehler getriggert.
Habe oben noch einen zusätzlichen Check eingebaut der prüft ob die Datei 0 Bytes hat.

p.s. deine Files sind ANSI, du kannst in der Abfrage also mit Nein antworten oder die Abfrage entfernen und die 1252 direkt an der passenden Stelle eintragen (s.o.)

Eine Frage:

Warum machst machst du die Zusammenfassung mit VBA, so wie deine CSV-Dateien vermuten lassen, habt Ihr sie mit Powershell generiert. Dann würde ich auch Powershell dazu verwenden sie zusammenzufassen, das wäre damit ein Einzeiler face-wink für alle Ordner.

Grüße Uwe
Mitglied: mtufangil
mtufangil 13.10.2016 um 10:04:48 Uhr
Goto Top
Hast auch recht. Wäre einfacher beim verarbeiten der CSV Dateien.
Werde das dann auch mal optimieren.

Ach ja, es hat funktioniert face-smile
Echt viele Dank!!!
Ich hoffe ich kann mich irgendwie erkenntlich zeigen für deine Mühe.
Mitglied: colinardo
colinardo 13.10.2016 um 10:10:14 Uhr
Goto Top
Zitat von @mtufangil:
Ich hoffe ich kann mich irgendwie erkenntlich zeigen für deine Mühe.

Wie immer gerne hier

Merci.

Grüße Uwe