Office: (Office 2019) VBA - Dateien auslesen und strukturiert ausgeben

Helfe beim Thema VBA - Dateien auslesen und strukturiert ausgeben in Microsoft Excel Hilfe um das Problem gemeinsam zu lösen; Hallo zusammen, ich möchte gerne eine Übersichtsdatei erstellen, welche ein Verzeichnis inklusive der Unterverzeichnisse ausliest und die darin... Dieses Thema im Forum "Microsoft Excel Hilfe" wurde erstellt von Chaoswolf, 21. Dezember 2022.

  1. Chaoswolf
    Chaoswolf User

    VBA - Dateien auslesen und strukturiert ausgeben


    Hallo zusammen,

    ich möchte gerne eine Übersichtsdatei erstellen, welche ein Verzeichnis inklusive der Unterverzeichnisse ausliest und die darin enthaltenen Dateien in eine Excel Tabelle ausgibt.

    Ich habe bereits einen sehr gut funktionierenden Code auf Excelbaby gefunden.

    Code:
    Option Explicit
    
    Sub ListFile()
        ''Description: List all files in folder and sub-folders (include hidden ,read only...)
        ''Web Site: https://excelbaby.com
        ''Url: https://excelbaby.com/learn/excel-macro-list-all-files-in-folders-and-subfolders/
    
        Dim PathSpec As String
        PathSpec = ActiveWorkbook.Path  'Specify a folder
        If (PathSpec = "") Then PathSpec = SelectSingleFolder   'Browse for Folder to select a folder
    
        Dim fso As Object
        Set fso = CreateObject("Scripting.FileSystemObject")    'Late Binding
        If (fso.FolderExists(PathSpec) = False) Then Exit Sub   'folder exist or not?
    
        Application.ScreenUpdating = False 'Disable Screen Updating to speed up macro
      
        Dim MySheetName As String
        MySheetName = "Files"   'Add a Sheet with name "Files"
        AddSheet (MySheetName)
    
        Dim FileType As String
        FileType = "*"   '*:all, or pdf, PDF, XLSX...
        FileType = UCase(FileType)
    
        Dim queue As Collection, oFolder As Object, oSubfolder As Object, oFile As Object
        Dim LastBlankCell As Long, FileExtension As String
    
        Set queue = New Collection
        queue.Add fso.getfolder(PathSpec) 'enqueue
      
        Do While queue.Count > 0
            Set oFolder = queue(1)
            queue.Remove 1 'dequeue
          
            For Each oSubfolder In oFolder.SubFolders   'loop all sub-folders
                queue.Add oSubfolder 'enqueue
                '...insert any folder processing code here...
            Next oSubfolder
          
            LastBlankCell = ThisWorkbook.Sheets(MySheetName).Cells(Rows.Count, 1).End(xlUp).Row + 1 'get the last blank cell of column A
          
            For Each oFile In oFolder.Files 'loop all files
                FileExtension = UCase(Split(oFile.Name, ".")(UBound(Split(oFile.Name, ".")))) 'get file extension, eg: TXT
                If (FileType = "*" Or FileExtension = FileType) Then
                    With ThisWorkbook.Sheets(MySheetName)
                        .Cells(LastBlankCell, 1) = oFile 'Path
                        .Cells(LastBlankCell, 2) = oFolder 'Folder
                        .Cells(LastBlankCell, 3) = oFile.Name 'File Name
                        .Cells(LastBlankCell, 4) = FileExtension 'File Extension
                        .Cells(LastBlankCell, 5) = oFile.DateCreated 'Data Created
                        .Cells(LastBlankCell, 6) = oFile.DateLastAccessed 'Last Accessed
                        .Cells(LastBlankCell, 7) = oFile.DateLastModified 'Last Modified
                        .Cells(LastBlankCell, 8) = oFile.Size 'File Size
                        If (oFile.Attributes And 2) = 2 Then
                            .Cells(LastBlankCell, 9) = "TRUE" 'Is Hidden
                        Else
                            .Cells(LastBlankCell, 9) = "FALSE" 'Is Hidden
                        End If
                    End With
                    LastBlankCell = LastBlankCell + 1
                End If
            Next oFile
        Loop
      
        'Cells.EntireColumn.AutoFit  'Autofit columns width
        Application.ScreenUpdating = True
    
    End Sub
    
    Function SelectSingleFolder()
        'Select a Folder Path
      
        Dim FolderPicker As FileDialog
        Dim myFolder As String
      
        'Select Folder with Dialog Box
        Set FolderPicker = Application.FileDialog(msoFileDialogFolderPicker)
      
        With FolderPicker
            .Title = "Select A Single Folder"
            .AllowMultiSelect = False
            If .Show <> -1 Then Exit Function 'Check if user clicked cancel button
            SelectSingleFolder = .SelectedItems(1)
        End With
    End Function
    
    Function AddSheet(MySheetName As String)
        'Add a worksheet with custom name
      
        Dim Mysheet As Worksheet, F As Boolean
        For Each Mysheet In ThisWorkbook.Worksheets
            If Mysheet.Name = MySheetName Then
                Sheets(MySheetName).Cells.Delete
                F = True
                Exit For
            Else
                F = False
            End If
        Next
        If Not F Then Sheets.Add.Name = MySheetName
      
        'Add table header
        With Sheets(MySheetName)
            .Cells(1, 1) = "Path"
            .Cells(1, 2) = "Folder"
            .Cells(1, 3) = "File Name"
            .Cells(1, 4) = "File Extension"
            .Cells(1, 5) = "Data Created"
            .Cells(1, 6) = "Last Accessed"
            .Cells(1, 7) = "Last Modified"
            .Cells(1, 8) = "Size"
            .Cells(1, 9) = "Is Hidden"
        End With
    End Function
    Bei einer beispielhaften Verzeichnisstruktur:

    Code:
    Farben
    |   Dateien auslesen und ausgeben.xlsm
    |   
    +---dunkle Farben
    |       grau.txt
    |       schwarz.txt
    |       
    \---helle Farben
            rosa.txt
            weiß.txt
    sieht das Ergebnis so aus:

    VBA - Dateien auslesen und strukturiert ausgeben upload_2022-12-21_14-44-12.png
    (Excel Datei im Anhang)

    Mein Wunschwäre jedoch, dass es wie folgt aussieht
    VBA - Dateien auslesen und strukturiert ausgeben upload_2022-12-21_14-49-2.png

    Die nicht benötigten Spalten bekomme ich selber weg. Was ich aber nicht hinbekomme, ist das die Unterverzeichnisse als Überschrift vorangestellt dargestellt werden, statt das der Pfad als eigene Spalte vorangestellt wird.

    Hier wäre ich für einen Ratschlag sehr dankbar!
     
    Chaoswolf, 21. Dezember 2022
    #1
  2. Hajo_Zi
    Hajo_Zi Erfahrener User
    mache die Farbe mit bedingter Formatierung
    =Und(A1<>"";Rest(Zeile();6)=0
    für die anden Farben 1 bis 5

    VBA - Dateien auslesen und strukturiert ausgeben GrußformelVBA - Dateien auslesen und strukturiert ausgeben Homepage
     
  3. Chaoswolf
    Chaoswolf User
    Hallo Hajo,

    erst einmal vielen Dank für die Hilfe. Ich glaube ich habe mich unpräzise ausgedrückt bzw. das Beispiel mit den Farben war schlecht gewählt.

    Es geht mir gar nicht um die Formatierung bzw. die Farben, sondern um den Output, den das Makro strukturell erzeugt.

    Ich möchte, dass die Unterverzeichnisse als Überschriften über den Dateien angeordnet werden, statt als separate Spalte vor dem Dateinamen.
     
    Chaoswolf, 21. Dezember 2022
    #3
Thema:

VBA - Dateien auslesen und strukturiert ausgeben

Die Seite wird geladen...
  1. VBA - Dateien auslesen und strukturiert ausgeben - Similar Threads - VBA Dateien auslesen

  2. Bestimmte Zellen aus geschlossenen Dateien in eine Master Liste hineinkopieren VBA

    in Microsoft Excel Hilfe
    Bestimmte Zellen aus geschlossenen Dateien in eine Master Liste hineinkopieren VBA: Hallo, ich bin an meiner Thesis dran und möchte Protokolle auswerten. Dazu habe ich Dateien, die Tageswerte enthalten. Ich möchte aus jeder Datei die gleichen Zellen kopieren und in eine...
  3. Binäre Dateien verarbeiten

    in Microsoft Access Hilfe
    Binäre Dateien verarbeiten: Hallo zusammen, nachdem ich weder auf deutsch- noch englischsprachigen Foren fündig werde, bitte ich Euch um Unterstützung. Ich habe eine PostgreSQL-Datenbank, darin Bytea-Felder gefüllt mit...
  4. Excel VBA Datei durchsuchen, Datentyp prüfen und bestimmten Inhalt auslesen

    in Microsoft Excel Hilfe
    Excel VBA Datei durchsuchen, Datentyp prüfen und bestimmten Inhalt auslesen: Hallo liebe Community, ich muss mit einem VBA-Code bei einer Nessus-Datei prüfen, ob bei einer Stelle wo normalerweise eine IP-Adresse stehen sollte ein Hostname steht(z.B. HSTSERV02) (müsste...
  5. Über Makro Daten aus Dateien auslesen

    in Microsoft Excel Hilfe
    Über Makro Daten aus Dateien auslesen: Hallo zusammen! Wer kann helfen? Ich möchte ein Makro erstellen, das aus dem aktuellsten Excel-Files in einem Ordner (z.B. d:\Daten\) die Werte B7 bis B26 in meine aktuelle Excel-Datei holt und...
  6. aus verschiedenen xls dateien auslesen und in ein formular auflisten

    in Microsoft Excel Hilfe
    aus verschiedenen xls dateien auslesen und in ein formular auflisten: Hallo, ich hoff das mir jemand helfen kann... mein problemm: habe ca. 1200 xls dateien wo ich die adressdaten auslesen und in einer neuen datei (tabellenblatt) eintragen muss. die auszulesenden...
  7. VBA - Spalte aus Excel Datei auslesen

    in Microsoft Excel Hilfe
    VBA - Spalte aus Excel Datei auslesen: :-) Hallo, ich kenne mich mit VBA garnicht aus. Ich habe in einem Arbeitsblatt in Excel in der Spalte E5 bis E365 Zahlen drin stehen. Diese möchte ich gerne auslesen und dann in einer...
  8. Daten aus anderen Dateien mit VBA auslesen

    in Microsoft Excel Hilfe
    Daten aus anderen Dateien mit VBA auslesen: Hallo Alle! Ich hoffe ihr könnt mir ein bisschen helfen. Ich habe folgendes Problem. Jeden morgen bekomme ich Rapports geliefert und wuerde gerne Kennziffern aus denen in eine neue Excel Datei...
Schlagworte:
  1. Diese Seite verwendet Cookies, um Inhalte zu personalisieren, diese deiner Erfahrung anzupassen und dich nach der Registrierung angemeldet zu halten.
    Auf dieser Website werden Cookies für die Zugriffsanalyse und Anzeigenmessung verwendet.
    Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies.
    Information ausblenden