Liste de films

Résolu

Papyjoyeux -
yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention - 7 févr. 2021 à 22:13

Bonjour,
Je possède un disque sur lequel j'ai plusieurs répertoires contenant des films.
Je cherche le moyen de lister ces films sur Excel 2010, par répertoire.
Cette liste devrait contenir le nom des films (c'est le minimum !!!) ainsi que la taille et la durée de chacun

D'une manière générale, je cherche à lister le contenu d'un répertoire avec les diverses propriétés de chaque élément contenu dans ce répertoire.

Merci pour vos éventuelles réponses

Afficher la suite

A voir également:

2 réponses

Réponse 1 / 2

jordane45 Messages postés 38486 Date d'inscription Statut Modérateur Dernière intervention 4 752

Bonjour,
Avec une rapide recherche sur le net,
par exemple :
https://www.google.com/search?q=vba+list+files+in+folder
et encore :
https://www.google.com/search?q=vba+video+file+properties

Ca devrait te permettre de trouver un code du genre

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

Réponse 2 / 2

yg_be Messages postés 23541 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 584

bonjour,
ceci te donnera toutes les propriétés de tes fichiers:

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

Votre réponse