copier des données dans excel

[srv35]

Bonjour,j'enregistre des chansons sur beezik.Ces chansons sont enregistrées dans le dossier "ma musique".Je voudrais importer les valeurs de durée des chansons indiquées dans le dossier "ma musique" dans excel afin de les additionnées.Merci

 

[Staple1600]

Re : copier des données dans excel

Bonjour et bienvenue.


Voir dans ce fil, peut-être


PS: peux-tu stp compléter le titre de ton message (en y ajoutant par exemple qu'il s'agit de de fichiers MP3) . Merci

 

[PMO2]

Re : copier des données dans excel

Bonjour,

Une piste avec le code suivant à copier dans un module standard.
La constante cernée par des ### est à adapter à votre usage.

'### 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

Le résultat s'affiche dans une nouvelle feuille.

Cordialement.

PMO
Patrick Morange