Lister les attributs des fichiers MP3 d'un répertoire

Comment récupérer par VBA les attributs d'un fichier MP3 tels que "artiste", "débit"...

Si tu as XP:
Option Explicit

 sub MP3_Listing()
 Dim sPath As String: sPath = GetShellFolder
 If sPath = "" Then exit sub
 If Dir(sPath, vbDirectory) = "" Then Exit sub
 Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
 Dim objShell As Object, oFolder As Object
 Set objShell = CreateObject("Shell.Application")
 Set oFolder = objShell.NameSpace(CStr(sPath))
 Application.ScreenUpdating = False
 Workbooks.Add
 For i = 0 To 34
 Headers(i) = oFolder.GetDetailsOf(oFolder.Items, i)
 Select Case i
 Case 0 To 1, 10, 12, 14 To 18, 20 To 22
 x = x + 1
 Cells(1, x) = Headers(i)
 End Select
 Next
 y = 1
 For Each oFile In oFolder.Items
 p = oFile.Path: n = oFile.Name
 If Right$(n, 4) = ".mp3" Then
 x = 0: y = y + 1
 For i = 0 To 34
 Select Case i
 Case 0 To 1, 10, 12, 14 To 18, 20 To 22
 x = x + 1
 Cells(y, x) = oFolder.GetDetailsOf(oFile, i)
 With ActiveSheet
 .Hyperlinks.Add .Range("A" & y), Hlink(p), , n, n
 End With
 End Select
 Next
 End If
 Next
 Range("A2").Select
 ActiveWindow.FreezePanes = True
 Rows("1:1").Font.Bold = True
 Cells.Columns.AutoFit
 Range("A1").Select
 Set oFolder = Nothing: Set objShell = Nothing
 end sub
 
 Private Function GetShellFolder() As String
 Const Title = "Sélectionnez un répertoire !"
 Dim oSHA As Object, oSF As Object, oItem As Object
 On Error GoTo 1
 Set oSHA = CreateObject("Shell.Application")
 Set oSF = oSHA.BrowseForFolder(0, Title, &H1 Or &H10, &H11)
 If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
 For Each oItem In oSF.parentfolder.Items
 If oItem.Name = oSF.Title Then
 GetShellFolder = oItem.Path
 Exit Function
 End If
 Next
 GetShellFolder = oSF.Title
 Set oSF = Nothing: Set oSHA = Nothing
 Exit Function
 1: MsgBox "Error: " & Err.Number & vbLf & Err.Description, 48
 End Function
 
 Private Function Hlink(p As String) As String
 Hlink = "file:///" & Replace(Replace(p, " ", "%20"), "", "/")
 End Function
 

Sinon tu peux aussi regarder de ce côté :

Type MP3Tag
  ID As String * 3
  Title As String * 30
  Artist As String * 30
  Album As String * 30
  Year As String * 4
  Comment As String * 28
  ID3Tag As Byte
  TrackNumber As Byte
 End Type
 
 sub test()
 Const cRecordLen = 128
 Dim strFile As String, lngFileLen As Long
 Dim tag As MP3Tag, intFF As Integer
 
  strFile = "U:\Music\Jerry Lee Lewis - Jerry Goes Country - More and
 more.mp3"
  lngFileLen = FileLen(strFile)
 
  intFF = FreeFile
  Open strFile For Binary Access Read As intFF
 
  Get intFF, lngFileLen - cRecordLen + 1, tag
 
  If tag.ID = "TAG" Then
 
    Debug.Print tag.Album; Tab; tag.TrackNumber; Tab; tag.Title
  End If
 
  Close intFF
 
 end sub

Auteurs : ,

Mots clefs associés à cette page : , , , , ,