Dateiinfo aller Dateien in allen Verz./Unterverz

Hallo liebe Herber-Freunde
mit folgendem Code (Quelle Archiv) kann ich alle Dateiinformationen aus einem definierten Verzeichnis auslesen >> funktioniert prima !
Ich benötige jedoch eine Möglichkeit, daß ein Makro dieses auch für die jeweiligen Unterverzeichnisse und der darin enthaltenen Dateien durchführt !
Wie kann man so etwas machen ?
Freu mich auf eine Antwort
Besten Gruß
Stefan
hier der Code:
' **********************************************************************
' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit


Sub Dateieigenschaften()
'von k.rola
Const STRFOLDER As String = "D:\Daten" 'anpassen
Dim objShell As Object
Dim objFolder As Object
Dim x As Byte
Dim spalte As Integer
Dim zeile As Long
Dim varName, arrHeaders(34)
If Dir(STRFOLDER, 16) = "" Then
MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!" & Space(10), 64, "weise hin..."
Exit Sub
End If
Application.ScreenUpdating = False
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(STRFOLDER)
spalte = 1
For x = 0 To 33
arrHeaders(x) = objFolder.GetDetailsOf(varName, x)
Cells(1, spalte + x) = arrHeaders(x)
Next
Rows(1).Font.Bold = True
zeile = 2
For Each varName In objFolder.Items
For x = 0 To 33
Cells(zeile, spalte + x) = objFolder.GetDetailsOf(varName, x)
Next
zeile = zeile + 1
Next
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Stefan,
versuch es mal damit:

' **********************************************************************
' Modul: Modul1 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Sub Dateieigenschaften()
    Const STRFOLDER As String = "D:\Eigene Dateien" 'anpassen
    Dim objShell As Object, objFolder As Object
    Dim lngColumn As Long, lngRow As Long
    Dim vntFile As Variant
    Dim strPath As String, strFile As String

    If Dir(STRFOLDER, 16) = "" Then
        MsgBox "Der Ordner " & STRFOLDER & " wurde nicht gefunden!", vbCritical, "Fehler"
        Exit Sub
    End If

    Application.ScreenUpdating = False

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(STRFOLDER)

    Cells.Clear
    Cells(1, 1).Value = "Pfad"
    lngRow = 1

    For lngColumn = 0 To 50
        Cells(lngRow, lngColumn + 2) = objFolder.GetDetailsOf("", lngColumn)
    Next

    Rows(1).Font.Bold = True

    With Application.FileSearch
        .NewSearch
        .FileType = msoFileTypeAllFiles
        .LookIn = STRFOLDER
        .SearchSubFolders = True
        .Execute

        For Each vntFile In .FoundFiles
            lngRow = lngRow + 1
            strPath = Left$(vntFile, InStrRev(vntFile, "\") - 1)
            strFile = Right$(vntFile, Len(vntFile) - InStrRev(vntFile, "\"))
            Set objFolder = objShell.Namespace((strPath))
            Cells(lngRow, 1).Value = strPath
            For lngColumn = 0 To 50
                Cells(lngRow, lngColumn + 2).Value = objFolder.GetDetailsOf( _
                    objFolder.ParseName(strFile), lngColumn)
            Next
        Next

    End With

    Columns.AutoFit
    Application.ScreenUpdating = True

End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

Dateiinfo aller Dateien in allen Verz./Unterverz

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread