Liste de films

Option Explicit
Sub GetVideos()
    Dim fileType, fileNames, movieFile
    Dim nextRow As Excel.Range
     
    For Each fileType In Array(".avi", ".mkv", ".mpeg4", ".mov") '// add more as required...
         '// Black console box may appear at this point for a while, this is normal...
        fileNames = Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR ""C:\*" & fileType & """ /S /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
        For Each movieFile In fileNames
            Set nextRow = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
            nextRow.Value = GetProperties(CStr(movieFile), 0)
            nextRow.Offset(0, 1).Value = GetProperties(CStr(movieFile), 1)
            nextRow.Offset(0, 2).Value = GetProperties(CStr(movieFile), 27)
            nextRow.Offset(0, 3).Value = GetProperties(CStr(movieFile), 182)
            nextRow.Offset(0, 4).Value = GetProperties(CStr(movieFile), 284)
        Next
    Next
     
    With Range("A1:E1")
        .Value = Array("Name", "Size", "Length", "Type", "Frame Rate")
        .EntireColumn.AutoFit
    End With
     
End Sub
 
Function GetProperties(file As String, propertyVal As Integer) As Variant
Dim varfolder, varfile
    With CreateObject("Shell.Application")
        Set varfolder = .Namespace(Left(file, InStrRev(file, "\") - 1))
        Set varfile = varfolder.ParseName(Right(file, Len(file) - InStrRev(file, "\")))
        GetProperties = varfolder.GetDetailsOf(varfile, propertyVal)
    End With
End Function

Option Explicit
Dim labels() As String, maxdet As Long
Private Sub allattr()
Dim app As Shell, i As Long, det As String, cedossier As Folder
Set app = New Shell
Set cedossier = app.Namespace(ThisWorkbook.Path)
For i = 0 To 1000
    det = cedossier.GetDetailsOf(Null, i)
    If det <> "" Then
        maxdet = i
        Debug.Print i, det
        ReDim Preserve labels(maxdet)
        labels(maxdet) = det
    End If
Next i
End Sub
Private Sub proprietesFichiers()

Dim objShell As Shell
Dim strFileName
Dim objFolder As Folder
Dim Resultat As String
Dim i As Byte
Call allattr
Set objShell = New Shell
Set objFolder = objShell.Namespace(ThisWorkbook.Path)
Call explore(objShell, objFolder)
End Sub
Private Sub explore(app As Shell, ledossier As Folder)
Dim fo As FolderItem2, undossier As Folder, det As String, i As Long
For Each fo In ledossier.Items
    If fo.isFolder Then
        Debug.Print "dossier: ", fo.Path
        Set undossier = app.Namespace(fo.Path)
        Call explore(app, undossier)
    Else
        Debug.Print "      fichier: ", fo.Name
        For i = 0 To maxdet
            det = ledossier.GetDetailsOf(fo, i)
            If det <> "" Then
                Debug.Print "                ", labels(i), det
            End If
        Next i
    End If
Next fo
End Sub