Excel VBA - CSV Headers auflisten?

BaseBallBatBoy

Erfahrenes Mitglied
Hi!

Ich habe einen Ordner mit ca. 250 CSV Files wobei jedes zwischen 5-50 Spalten hat. Diese möchte ich nun Dokumentieren, dh. am Ende brauche ich eine Tabelle mit dem Filenamen und den entsprechenden Spaltennamen.

z.B. test.csv mit dem hearder col1; col2 sollte mir zwei Einträge in der Tabelle ergeben: test.csv col1 und test.csv col2. Also einfach alle Spalten aus allen Files auflisten.

Kann man das mit VBA lösen und wenn ja wie? Ich stelle mir sowas vor wo man einen Ordner auswähl, dann einen Knopf drückt und die Liste wird erstellt.

Gruss
BBBB
 
Ich habe nun eine Lösung gefunden:

Visual Basic:
Private Sub MakeCSVlist()
    Dim oFileSystem
    Dim oTextStream
    Dim oFile
    Dim lRow As Long, lPos As Long, lLength As Long
    Dim FolderPath As String, sLine As String, sDelim As String
    
    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    
    ' Start operations
    Sheet1.Cells(10, 3).Value = ""
    Sheet2.Cells.ClearContents
    
    lRow = 1
    
    ' Set headers for output list
    Sheet2.Cells(lRow, 1).Value = "FILE_NAME"
    Sheet2.Cells(lRow, 2).Value = "COLUMN_NAME"
    
    ' Data list will start at position 2
    lRow = lRow + 1
    
    ' Set delimeter for CSV files
    sDelim = ","
    
    ' Change this to your folder path or set it using an InputBox
    'FolderPath = "C:\Users\DON-Admin\Desktop\test"
    FolderPath = Sheet1.Cells(4, 3).Value
    
    ' ensure we are working with a real folder
    If oFileSystem.FolderExists(FolderPath) Then
    
        'cycle through each file in folder
        For Each oFile In oFileSystem.GetFolder(FolderPath).Files
    
            ' make sure it is the correct file type (either *.CSV or *.csv")
            If VBA.Strings.LCase(VBA.Strings.Right(oFile.Name, 4)) = ".csv" Then
            
                ' Get first line
                Set oTextStream = oFile.OpenAsTextStream(1, -2)
                sLine = oTextStream.ReadLine
                oTextStream.Close
                
                lPos = 1

                While VBA.Strings.InStr(lPos, sLine, sDelim) > 0
                    lPos = VBA.Strings.InStr(lPos, sLine, sDelim)
                    lLength = VBA.Strings.InStr(lPos + 1, sLine, sDelim)
                    If lLength > 0 Then
                        lLength = lLength - (lPos + 1)
                    Else
                        lLength = VBA.Strings.Len(sLine) - lPos
                    End If
                    Sheet2.Cells(lRow, 1).Value = oFile.Name
                    Sheet2.Cells(lRow, 2).Value = VBA.Strings.Mid(sLine, lPos + 1, lLength)
                    lRow = lRow + 1
                    lPos = lPos + 1
                Wend
            End If
        Next oFile
    Else
        ' no folder was found, let us know
        MsgBox "Folder was not found"
    End If
    
    Sheet1.Cells(10, 3).Value = "DONE"
    
    Set oTextStream = Nothing
    Set oFileSystem = Nothing
End Sub
 
Zuletzt bearbeitet von einem Moderator:
Es stimmt, dass Line Input schon sehr lange existiert (länger als das FSO), und ich habe eben mit VB angefangen als es das FSO eben noch nicht gab. Ist es deswegen veraltet? Sicher nicht.
Ich konnte mich nunmal nie an die Syntax gewöhnen, die ich persönlich fürchterlich finde.
Ausserdem habe ich nun aus diversen unabhängigen Quellen mehrfach bestätigt bekommen, dass das FSO im Vergleich zu den hauseigenen VB-Funktionen deutlich langsamer ist, geschweige denn zu API-Funktionen.
Ansonsten ist es wie im Leben: Geschmackssache! :)
 

Neue Beiträge

Zurück