Lister les attributs des fichiers MP3 d'un répertoire
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 subAuteurs : Rob Van Gelder, Michel Pierron
Mots clefs associés à cette page : liste, lister, musique, répertoire, son, mp3
- Vous devez vous identifier ou créer un compte pour écrire des commentaires
