XL 2013 extraction détails du répertoire vers excel

[PERONI DANIEL]

Bonjour, je dois parfois extraire des données d'un répertoire pour les insérer dans excel.
Notamment la longueur de fichier audio (mp3, m4a et mp4) qui apparait dans les détails de l'explorateur.
J'ai essayer plusieurs méthode sans succès même quand la colonne de la longueur du fichier est affichée.
Les seules données que j'ai réussi à extraire sont le nom, la date de modification et la taille.
Merci de m'aider.

 

[fanch55]

Bonsoir,

Private Sub test()
    Cells.Delete
    Set fso = CreateObject("Scripting.FileSystemObject")
        With fso.GetFolder("......................") 'Liste les fichiers du répertoire
            [A1].Resize(, 4) = Array("Nom", "Octets", "K Octets", "M Octets")
            [A1].Offset(1).Select
            On Error Resume Next
            For Each File In .Files
                Selection = File.Name 'Place leurs noms ds le document
                Selection.Offset(, 1) = File.Size
                Selection.Offset(, 2) = Application.WorksheetFunction.Round(File.Size / 1024, 0)
                Selection.Offset(, 3) = Application.WorksheetFunction.Round(File.Size / 1024 ^ 2, 2)
                ActiveCell.Offset(1).Select
            Next
        End With
    Set fso = Nothing
    Columns.AutoFit
End Sub

 

[PERONI DANIEL]

Merci pour votre réponse mais je ne sais pas comment utiliser votre réponse et où.
Merci

 

[fanch55]

La macro donnée a des informations succinctes.
Pour plus d'infos sur les fichiers, utilisez le classeur ci-joint .
Cliquez sur l'icône Dossier
Il est à noter que l'exécution peut être longue selon les dossiers choisis et le nombre d'infos à retourner (320 Max).
La ligne 2 indique le n° de l'info , la ligne 1 la nature .

Concrétement dans votre cas, pour obtenir la durée d'un fichier audio :

Sub Durée()
    MsgBox Get_Info(27, ".....nom du fichier avec son dossier....")
End Sub
Function Get_Info(Id As Integer, ByVal File)
    Dim oFolder As Object, I As Integer
    I = Len(File) - InStr(1, StrReverse(File), "\", vbTextCompare)
    Set oFolder = CreateObject("Shell.Application").Namespace(Left(File, I))
        Get_Info = oFolder.GetDetailsOf(oFolder.Items.Item(Mid(File, I + 2)), Id)
    Set oFolder = Nothing
End Function

 

[PERONI DANIEL]

merci pour votre réponse
j'essaye la macro et je vous reviens
bonne journée.

 

[PERONI DANIEL]

Bonjour encore bravo pour votre travail.
La macro fonctionne parfaitement mais y-a-t'il moyen d'augmenter le nombre d'infos à retourner (ici limité à 320) car mes fichiers font tous +/- 10000 lignes?
Merci d'avance et bonne fin de journée.

 

[fanch55]

Bonjour,
le nombre d'infos de 320 est le max que peut retourner Windows.
Je n'ai pas mis de limite aux nombre de fichiers retournés .
Que vos fichier fassent 1 ou 10000 lignes importe peu car la macro ne les ouvre / lit pas .

 

[PERONI DANIEL]

Merci de votre rapide réponse et bon week-end