Decode MP3 ID3v2 and WMA tag info

[Tom D]

I need some help.

I am looking for a COM module (freeware) or vba code to
decode mp3 ID3v2 and WMA tag information. Already have
programed one for the old ID3 Tag. Based on what I have
already picked up (via www.id3.org)the ID3v2 and WMA are
a lot more involved. There are a lot of stand alone
editor programs but I am looking for code that I can
incorporate into a list builder/database I have
previously written.

My web search didn't yield any vba code or freeware COM
modules.

Any help would be greatly appreciated.

 

[Michel Pierron]

Hi Tom;
One example with WinXP:

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 = "Select MP3 repertory !"
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

Regards,
MP

 

[Tom D]

Michel
Thanks for the reply.

When I run the code I get a "438 Object doesn't support
this property or method" the error is triggered at the

For Each oItem In oSF.parentfolder.Items

Line of code....

What am I missing???

Thanks again
Tom D

 

[Tom D]

Michel,
Some additional info I should have added to last post:
Excel 2000 SP-3 and Win XP

Thanks again
Tom D

 

[Harald Staff]

Very useful piece of code, Michel. Thanks.

Best wishes Harald