'### Constante du dossier et son chemin à adapter ###
Const MON_DOSSIER = "c:\"
'####################################################
Sub PropertiesFileMusique()
Dim ShellApp As Object 'Shell32.Shell
Dim Fichier As Object 'Shell32.FolderItem
Dim Dossier As Object 'Shell32.Folder
Dim i&
Dim j&
Dim T()
Dim S As Worksheet
Dim R As Range
Set ShellApp = CreateObject("Shell.Application")
Set Dossier = ShellApp.Namespace(MON_DOSSIER)
If Dossier Is Nothing Then
MsgBox "Le dossier ''" & MON_DOSSIER & "'' est introuvable."
Exit Sub
End If
ReDim T(1 To Dossier.Items.Count + 1, 1 To 3)
i& = 1
For Each Fichier In Dossier.Items
If i& = 1 Then
T(i&, 1) = Dossier.GetDetailsOf(Dossier.Items, 0)
T(i&, 2) = Dossier.GetDetailsOf(Dossier.Items, 2)
T(i&, 3) = Dossier.GetDetailsOf(Dossier.Items, 21)
i& = i& + 1
Else
If Dossier.GetDetailsOf(Fichier, 21) <> "" Then
T(i&, 1) = Dossier.GetDetailsOf(Fichier, 0)
T(i&, 2) = Dossier.GetDetailsOf(Fichier, 2)
T(i&, 3) = Dossier.GetDetailsOf(Fichier, 21)
i& = i& + 1
End If
End If
Next Fichier
Set S = Sheets.Add
Set R = S.Range(S.Cells(1, 1), S.Cells(UBound(T, 1), UBound(T, 2)))
R = T
With S.Range(S.Cells(1, 1), S.Cells(1, UBound(T, 2)))
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 34
End With
S.Columns.AutoFit
Set ShellApp = Nothing
End Sub