Eigenschaften ergänzen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Elfriede,
teste mal:

Private Sub list_files(r As Range, ordner As Object)

    Const PICTURE_HEIGHT As String = "Höhe"
    Const PICTURE_WIDTH As String = "Breite"

    Dim file As Object
    Dim subordner As Object
    Dim objFolder As Object
    Dim lngIndex As Long, lngHeightIndex As Long, lngWidthIndex As Long

    Static sobjShell As Object

    Application.ScreenUpdating = False

    If sobjShell Is Nothing Then Set sobjShell = CreateObject("Shell.Application")

    Set objFolder = sobjShell.Namespace(ordner.Path & "\")

    For lngIndex = 0 To 300
        Select Case objFolder.GetDetailsOf(Empty, lngIndex)
            Case PICTURE_HEIGHT
                lngHeightIndex = lngIndex
            Case PICTURE_WIDTH
                lngWidthIndex = lngIndex
        End Select
    Next

    For Each file In ordner.Files
        'R(1) = file.Name
        'R(2) = DateValue(file.DateLastModified)
        'R(3) = TimeValue(file.DateLastModified)
        'R(4) = file.Size / 1024
        'R(5) = ordner.Path

        r(1) = ordner.Path
        r(2) = file.Name
        r(3) = file.Size / 1024
        r(4) = DateValue(file.DateCreated)
        r(5) = TimeValue(file.DateCreated)
        r(6) = DateValue(file.DateLastModified)
        r(7) = TimeValue(file.DateLastModified)
        r(8) = DateValue(file.DateLastAccessed)
        r(9) = TimeValue(file.DateLastAccessed)
        r(10) = Replace(objFolder.GetDetailsOf(objFolder.ParseName(file.Name), lngHeightIndex), " Pixel", vbNullString)
        r(11) = Replace(objFolder.GetDetailsOf(objFolder.ParseName(file.Name), lngWidthIndex), " Pixel", vbNullString)

        Set r = r.Offset(1)
    Next

    For Each subordner In ordner.SubFolders
        If (subordner.Attributes And 4) = 0 Then Call list_files(r, subordner) '/System-Ordner/
    Next

    'Range("B:B,F:F").HorizontalAlignment = xlRight
    Range("D2:L2").HorizontalAlignment = xlCenter
    Range("B:B,C:C").HorizontalAlignment = xlLeft
    Range("K:K,L:L").HorizontalAlignment = xlRight
    'Range("D:F").HorizontalAlignment = xlCenter
    Range("A2:L2").Interior.ColorIndex = 35
    Range("A2:L2").Font.Bold = True
    'Range("B:F").Columns.AutoFit

    Application.ScreenUpdating = True
End Sub

Wenn du die Abmessungen von Videos auch sehen willst müssen wir das ergänzen.
Gruß
Nepumuk

Hallo Elfriede,
eine Übersetzung der Eigenschaften kann ich dir nicht nennen. Ich lese diese mit einem Makro aus:

Public Sub Dateieigenschaften()

    Const FOLDER_PATH As String = "G:\Eigene Dateien\Eigene Bilder\Fotos\Neuer Ordner\" 'Ordner anpassen !

    Dim objShell As Object, objFolder As Object
    Dim lngIndex As Long

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

    Application.ScreenUpdating = False

    Cells.Clear

    For lngIndex = 0 To 400
        Cells(lngIndex + 1, 1) = objFolder.GetDetailsOf(Empty, lngIndex)
    Next

    Application.ScreenUpdating = True

    Set objFolder = Nothing
    Set objShell = Nothing

End Sub

Und, nach der Nummer kannst du nicht gehen da sich die von Rechner zu Rechner unterscheiden. Denn die eine oder andere Software erzeugt bei der Installation neue Ordnereigenschaften welche die anderen in der Reihenfolge verschieben.
Hier deine geänderte Mappe (die Eigenschaften Breite und Höhe kann ich bei Dateien die direkt auf dem Laufwerk liegen also z.B. G:\Bild.jpg nicht auslesen):
https://www.herber.de/bbs/user/130273.xlsm
Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread