Discussion :

[Kikoune_M27]

Bonjour à tous,
Il y a très longtemps, j’ai « créé » le code suivant en améliorant un code trouvé sur ce site.
Il permet de lister tous les fichiers d’un répertoire et des sous-répertoires.
Or, maintenant, je souhaiterai m’attaquer aux fichiers audios. Pour ce faire, j’aurai besoin d’jouter des colonnes avec les informations concernant des infos de propriétés du fichier : le titre, interprètes ayant participé, album

Voir, plus généralement, la listes des propriétés….
Je ne trouve pas comment faire : HELPPPPP
Merci pour votre aide.


Voici le code :

Sub Lit_dossier(ByRef dossier, ByVal niveau)
' Cells(ligne, 1) = String(4 * (niveau - 1), " ") & "[" & dossier.Path & "]"
Cells(ligne, 1) = dossier.Path
Cells(ligne, 4) = dossier.Size
Cells(ligne, 6) = dossier.Files.Count
Cells(ligne, 1).Interior.ColorIndex = 36
ligne = ligne + 1
For Each f In dossier.Files
Cells(ligne, 1) = dossier.Path
Cells(ligne, 2) = f.Name
Cells(ligne, 2).Interior.ColorIndex = xlNone
Cells(ligne, 3) = Mid(f.Name, InStrRev(f.Name, ".") + 1)
Cells(ligne, 4) = f.Size
Cells(ligne, 5) = f.DateLastModified
Cells(ligne, 6) = f.Attributes
If f.Attributes And vbHidden Then Cells(ligne, 7) = "Caché"
ligne = ligne + 1
Next
For Each d In dossier.SubFolders
Lit_dossier d, niveau + 1
Next
End Sub

[sabot'age]

Bonjour,
Vous devriez link le fil sur lequel vous avez repris le code, parce qu'on ne sait pas la classe de la variable "dossier". Il me semble que c'est un filesystemobject mais ce n'est pas précisé dans le code.
Dans tous les cas, pour lire les métadonnées je ne suis pas sur qu'on puisse le faire avec cet objet, il faudra passer par des interfaces type shell. C'est aussi possible en Python si jamais.

[deedolith]

Hello,

Quelques améliorations supplémentaires:
- FSO permet d'obtenir directement l'extension d'un fichier: méthode GetExtentionName().
Donc inutile de se faire chier avec une recherche / séparation de chaîne (fonction Mid), d'autant qu'un fichier peut avoir plusieurs points dans son non, voir aucun (FSO prend cela en charge).
- Tu devrais dissocier d'une part la recherche des fichiers, et le reporting des données, ce sera plus versatile.

Concernant ton problème:
FSO ne retourne que les attributs standard (lecture / écriture / système / caché), il va falloir utiliser autre chose.
Cette page pourra peut t'aider (en passant par le shell):
https://www.mrexcel.com/board/thread...h-vba.1134506/

[Franc]

Salut, teste ceci:

Macro principale:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub ListerFichiersAvecMetadata()
    Dim chemin As String
    Dim ligne As Long
    Dim fso As Object
 
    chemin = "C:\Chemin\Vers\Votre\Dossier" ' À adapter
    Set fso = CreateObject("Scripting.FileSystemObject")
 
    ' Initialisation des en-têtes
    With Cells(1, 1).Resize(1, 10)
        .Value = Array("Dossier", "Fichier", "Extension", "Taille (octets)", "Date", "Attributs", "Titre", "Artiste", "Album", "Durée")
        .Font.Bold = True
    End With
 
    ligne = 2 ' Première ligne de données
    Lit_dossier fso.GetFolder(chemin), 1, ligne
End Sub

Lecture récursive des répertoires:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
Sub Lit_dossier(ByRef dossier As Object, ByVal niveau As Long, ByRef ligne As Long)
    Dim objShell As Object, objFolder As Object, objItem As Object
    Dim f As Object, d As Object, extension As String
 
    Set objShell = CreateObject("Shell.Application")
 
    ' Entête du dossier
    Cells(ligne, 1) = dossier.Path
    Cells(ligne, 1).Interior.ColorIndex = 36
    ligne = ligne + 1
 
    ' Fichiers
    For Each f In dossier.Files
        On Error Resume Next  ' Ignore les erreurs sur les fichiers corrompus
        Cells(ligne, 1) = dossier.Path
        Cells(ligne, 2) = f.Name
        extension = LCase(Mid(f.Name, InStrRev(f.Name, ".") + 1))
        Cells(ligne, 3) = extension
        Cells(ligne, 4) = f.Size
        Cells(ligne, 5) = f.DateLastModified
 
        ' Attributs (exemple : Archive, Hidden, etc.)
        Cells(ligne, 6) = AttrToString(f.Attributes)  ' Fonction personnalisée ci-dessous
 
        ' Métadonnées audio
        If InStr("mp3,wav,flac,aac,m4a", extension) > 0 Then
            Set objFolder = objShell.Namespace(dossier.Path)
            Set objItem = objFolder.ParseName(f.Name)
            If Not objItem Is Nothing Then
                ' Remplacez les indices selon votre système !
                Cells(ligne, 7) = objFolder.GetDetailsOf(objItem, 21)  ' Titre
                Cells(ligne, 8) = objFolder.GetDetailsOf(objItem, 20)  ' Artiste
                Cells(ligne, 9) = objFolder.GetDetailsOf(objItem, 14)  ' Album
                Cells(ligne, 10) = objFolder.GetDetailsOf(objItem, 27) ' Durée
            End If
        End If
 
        ligne = ligne + 1
        On Error GoTo 0
    Next f
 
    ' Sous-répertoires
    For Each d In dossier.SubFolders
        Lit_dossier d, niveau + 1, ligne
    Next d
 
    Columns("A:J").AutoFit
 
End Sub

Fonction pour convertir les attributs en texte:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Function AttrToString(attr As Integer) As String
    Dim result As String
    If attr And 1 Then result = result & "Read-Only, "
    If attr And 2 Then result = result & "Hidden, "
    If attr And 4 Then result = result & "System, "
    If attr And 32 Then result = result & "Archive, "
    AttrToString = Left(result, Len(result) - 2)
End Function

Macro pour récupérer tous les indices du fichier et à utiliser dans la macro Lit_dossier si nécessaire:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub ListerToutesPropriétés()
    Dim objShell As Object, objFolder As Object, objItem As Object
    Dim i As Integer, ligne As Integer
    Dim cheminFichierTest As String
 
    ' Chemin d'un fichier audio de test
    cheminFichierTest = "C:\Chemin\Vers\Votre\Dossier\Test.mp3"
 
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(Left(cheminFichierTest, InStrRev(cheminFichierTest, "\") - 1))
    Set objItem = objFolder.ParseName(Right(cheminFichierTest, Len(cheminFichierTest) - InStrRev(cheminFichierTest, "\")))
 
    ligne = 1
    For i = 0 To 300
        Cells(ligne, 1) = i
        Cells(ligne, 2) = objFolder.GetDetailsOf(Nothing, i)  ' Nom de la propriété
        Cells(ligne, 3) = objFolder.GetDetailsOf(objItem, i)  ' Valeur
        ligne = ligne + 1
    Next i
End Sub