Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default 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.
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 214
Default Decode MP3 ID3v2 and WMA tag info

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" a écrit dans le message de
...
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.


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default Decode MP3 ID3v2 and WMA tag info

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
-----Original Message-----
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" a écrit

dans le message de
...
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.


.

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 3
Default Decode MP3 ID3v2 and WMA tag info

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 = 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" a écrit

dans le message de
...
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.


.

  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 292
Default Decode MP3 ID3v2 and WMA tag info

Very useful piece of code, Michel. Thanks.

Best wishes Harald

"Michel Pierron" skrev i melding
...
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" a écrit dans le message de
...
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.




Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to decode integer timestamps? Ron West Excel Worksheet Functions 8 November 19th 08 05:51 PM
decode renuka Excel Discussion (Misc queries) 3 November 1st 07 08:50 AM
serial number decode chiuinggum Excel Worksheet Functions 6 June 13th 06 09:15 AM
Link info in one cell to info in several cells in another column (like a database) hansdiddy Excel Discussion (Misc queries) 1 February 22nd 06 02:27 AM
Decode from URL of hyperlink Murali Srinivasan Excel Programming 1 June 4th 04 02:52 AM


All times are GMT +1. The time now is 10:49 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"