MP3-Eigenschaften auslesen funzt nicht mehr

Sub Dateieigenschaften() Const STRFOLDER As String = "C:\Eigene Dateien" Dim objShell As Object, objFolder As Object Dim x As Byte, intColumn As Integer, lngRow 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) intColumn = 1 For x = 0 To 33 arrHeaders(x) = objFolder.GetDetailsOf(varName, x) Cells(1, intColumn + x) = arrHeaders(x) Next Rows(1).Font.Bold = True lngRow = 2 For Each varName In objFolder.Items For x = 0 To 33 Cells(lngRow, intColumn + x) = objFolder.GetDetailsOf(varName, x) Next lngRow = lngRow + 1 Next Columns.AutoFit Application.ScreenUpdating = True End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
du liest ja nur die ersten 34 Eigenschaften aus. In den neueren Betriebssystemen gibt es wesentlich mehr. Bei mir sind es zur Zeit 287, das kann von Rechner zu Rechner unterschiedlich sein da manche Programme bei der Installation neue Eigenschaften hinzufügen. Beachte, auch die Reihenfolge kann bei fast identischer Installation abweichen, da kommt es nämlich auch noch auf die Reihenfolge der Installation an.
So bekommst du alle Eigenschaften:

Public Sub Dateieigenschaften()

    Const FOLDER_PATH As String = "C:\Eigene Dateien"
    Const MAX_PROPERTYS As Long = 1000

    Dim objShell As Object, objFolder As Object
    Dim lngIndex As Long, lngRow As Long, lngMaxCount As Long
    Dim vntName As Variant
    Dim strTemp As String

    If Dir$(FOLDER_PATH, vbDirectory) <> vbNullString Then

        Application.ScreenUpdating = False

        Cells.Clear

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

        For lngIndex = 0 To MAX_PROPERTYS
            strTemp = objFolder.GetDetailsOf(vntName, lngIndex)
            If strTemp = vbNullString Then
                lngMaxCount = lngMaxCount - 1
                Exit For
            Else
                Cells(1, lngIndex + 1).Value = strTemp
                lngMaxCount = lngMaxCount + 1
            End If
        Next

        Rows(1).Font.Bold = True
        lngRow = 2

        For Each vntName In objFolder.Items
            For lngIndex = 0 To lngMaxCount
                Cells(lngRow, lngIndex + 1).Value = _
                    objFolder.GetDetailsOf(vntName, lngIndex)
            Next
            lngRow = lngRow + 1
        Next

        Columns.AutoFit
        Application.ScreenUpdating = True

    Else
        MsgBox "Der Ordner " & FOLDER_PATH & " wurde nicht gefunden!", _
            vbExclamation, "weise hin..."
    End If
End Sub

Gruß
Nepumuk

Public Sub Dateieigenschaften() ' Const FOLDER_PATH As String = "C:\test" Const MAX_PROPERTYS As Long = 1000 Dim objShell As Object, objFolder As Object Dim lngIndex As Long, lngRow As Long, lngMaxCount As Long Dim vntName As Variant Dim strTemp As String Dim FOLDER_PATH As String With Application.FileDialog(msoFileDialogFolderPicker) If .Show = -1 Then FOLDER_PATH = .SelectedItems(1) End If End With If Dir$(FOLDER_PATH, vbDirectory) vbNullString Then Debug.Print FOLDER_PATH Application.ScreenUpdating = False Cells.Clear Set objShell = CreateObject("Shell.Application") Set objFolder = objShell.Namespace(FOLDER_PATH) For lngIndex = 0 To MAX_PROPERTYS

Beliebteste Forumthreads (12 Monate)

MP3-Eigenschaften auslesen funzt nicht mehr

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread