Decode MP3 ID3v2 and WMA tag info

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.

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" <anonymous@discussions.microsoft.com> a écrit dans le message de
news:264001c514a2$83672680$a501280a@phx.gbl...
> 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
Thanks for the reply. =20

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

For Each oItem In oSF.parentfolder.Items

Line of code.... =20

What am I missing???

Thanks again
Tom D
>-----Original Message-----
>Hi Tom;
>One example with WinXP:
>
>Sub MP3_Listing()
>Dim sPath As String: sPath =3D GetShellFolder
>If sPath =3D "" Then Exit Sub
>If Dir(sPath, vbDirectory) =3D "" Then Exit Sub
>Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
>Dim objShell As Object, oFolder As Object
>Set objShell =3D CreateObject("Shell.Application")
>Set oFolder =3D objShell.NameSpace(CStr(sPath))
>Application.ScreenUpdating =3D False
>Workbooks.Add
>For i =3D 0 To 34
>Headers(i) =3D oFolder.GetDetailsOf(oFolder.Items, i)
>Select Case i
>Case 0 To 1, 10, 12, 14 To 18, 20 To 22
>x =3D x + 1
>Cells(1, x) =3D Headers(i)
>End Select
>Next
>y =3D 1
>For Each oFile In oFolder.Items
>p =3D oFile.Path: n =3D oFile.Name
>If Right$(n, 4) =3D ".mp3" Then
>x =3D 0: y =3D y + 1
>For i =3D 0 To 34
>Select Case i
>Case 0 To 1, 10, 12, 14 To 18, 20 To 22
>x =3D x + 1
>Cells(y, x) =3D 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 =3D True
>Rows("1:1").Font.Bold =3D True
>Cells.Columns.AutoFit
>Range("A1").Select
>Set oFolder =3D Nothing: Set objShell =3D Nothing
>End Sub
>
>Private Function GetShellFolder() As String
>Const Title =3D "Select MP3 repertory !"
>Dim oSHA As Object, oSF As Object, oItem As Object
>On Error GoTo 1
>Set oSHA =3D CreateObject("Shell.Application")
>Set oSF =3D oSHA.BrowseForFolder(0, Title, &H1 Or &H10,=20
&H11)
>If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
>For Each oItem In oSF.parentfolder.Items
>If oItem.Name =3D oSF.Title Then
>GetShellFolder =3D oItem.Path
>Exit Function
>End If
>Next
>GetShellFolder =3D oSF.Title
>Set oSF =3D Nothing: Set oSHA =3D Nothing
>Exit Function
>1: MsgBox "Error: " & Err.Number & vbLf &=20
Err.Description, 48
>End Function
>
>Private Function Hlink(p As String) As String
>Hlink =3D "file:///" & Replace(Replace(p, " ", "%
20"), "\", "/")
>End Function
>
>Regards,
>MP
>
>"Tom D" <anonymous@discussions.microsoft.com> a =E9crit=20
dans le message de
>news:264001c514a2$83672680$a501280a@phx.gbl...
>> 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=20
have
>> already picked up (via www.id3.org)the ID3v2 and WMA=20
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,
Some additional info I should have added to last post:
Excel 2000 SP-3 and Win XP

Thanks again
Tom D
>-----Original Message-----
>Hi Tom;
>One example with WinXP:
>
>Sub MP3_Listing()
>Dim sPath As String: sPath =3D GetShellFolder
>If sPath =3D "" Then Exit Sub
>If Dir(sPath, vbDirectory) =3D "" Then Exit Sub
>Dim Headers(35), x%, y&, i&, p$, n$, oFile As Object
>Dim objShell As Object, oFolder As Object
>Set objShell =3D CreateObject("Shell.Application")
>Set oFolder =3D objShell.NameSpace(CStr(sPath))
>Application.ScreenUpdating =3D False
>Workbooks.Add
>For i =3D 0 To 34
>Headers(i) =3D oFolder.GetDetailsOf(oFolder.Items, i)
>Select Case i
>Case 0 To 1, 10, 12, 14 To 18, 20 To 22
>x =3D x + 1
>Cells(1, x) =3D Headers(i)
>End Select
>Next
>y =3D 1
>For Each oFile In oFolder.Items
>p =3D oFile.Path: n =3D oFile.Name
>If Right$(n, 4) =3D ".mp3" Then
>x =3D 0: y =3D y + 1
>For i =3D 0 To 34
>Select Case i
>Case 0 To 1, 10, 12, 14 To 18, 20 To 22
>x =3D x + 1
>Cells(y, x) =3D 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 =3D True
>Rows("1:1").Font.Bold =3D True
>Cells.Columns.AutoFit
>Range("A1").Select
>Set oFolder =3D Nothing: Set objShell =3D Nothing
>End Sub
>
>Private Function GetShellFolder() As String
>Const Title =3D "Select MP3 repertory !"
>Dim oSHA As Object, oSF As Object, oItem As Object
>On Error GoTo 1
>Set oSHA =3D CreateObject("Shell.Application")
>Set oSF =3D oSHA.BrowseForFolder(0, Title, &H1 Or &H10,=20
&H11)
>If InStr(TypeName(oSF), "Folder") <> 1 Then Exit Function
>For Each oItem In oSF.parentfolder.Items
>If oItem.Name =3D oSF.Title Then
>GetShellFolder =3D oItem.Path
>Exit Function
>End If
>Next
>GetShellFolder =3D oSF.Title
>Set oSF =3D Nothing: Set oSHA =3D Nothing
>Exit Function
>1: MsgBox "Error: " & Err.Number & vbLf &=20
Err.Description, 48
>End Function
>
>Private Function Hlink(p As String) As String
>Hlink =3D "file:///" & Replace(Replace(p, " ", "%
20"), "\", "/")
>End Function
>
>Regards,
>MP
>
>"Tom D" <anonymous@discussions.microsoft.com> a =E9crit=20
dans le message de
>news:264001c514a2$83672680$a501280a@phx.gbl...
>> 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=20
have
>> already picked up (via www.id3.org)the ID3v2 and WMA=20
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.
>
>.
>

Very useful piece of code, Michel. Thanks.

Best wishes Harald

"Michel Pierron" <michel.pierron@free.fr> skrev i melding
news:ekRKCFNFFHA.732@TK2MSFTNGP12.phx.gbl...
> 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" <anonymous@discussions.microsoft.com> a écrit dans le message de
> news:264001c514a2$83672680$a501280a@phx.gbl...
> > 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.
>