Liste de films
Résolu/Fermé
Papyjoyeux
-
7 févr. 2021 à 20:21
yg_be Messages postés 23473 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 février 2025 - 7 févr. 2021 à 22:13
yg_be Messages postés 23473 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 18 février 2025 - 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
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:
- Liste de films
- Liste déroulante excel - Guide
- Liste déroulante en cascade - Guide
- Liste de diffusion whatsapp - Guide
- Liste site streaming illégal - Accueil - Services en ligne
- Téléchargement des films américains en français gratuit - Télécharger - TV & Vidéo
2 réponses
jordane45
Messages postés
38428
Date d'inscription
mercredi 22 octobre 2003
Statut
Modérateur
Dernière intervention
18 février 2025
4 735
7 févr. 2021 à 21:09
7 févr. 2021 à 21:09
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
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
yg_be
Messages postés
23473
Date d'inscription
lundi 9 juin 2008
Statut
Contributeur
Dernière intervention
18 février 2025
Ambassadeur
1 568
Modifié le 7 févr. 2021 à 22:15
Modifié le 7 févr. 2021 à 22:15
bonjour,
ceci te donnera toutes les propriétés de tes fichiers:
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