Liste de films

Résolu
Papyjoyeux -  
yg_be Messages postés 24281 Statut Contributeur -
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
A voir également:

2 réponses

Réponse 1 / 2
jordane45 Messages postés 40050 Statut Modérateur 4 756
 
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

1
Réponse 2 / 2
yg_be Messages postés 24281 Statut Contributeur 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
1