Hi all,

Just wanted to share a class I put together using various scripts
found online that I customized to work cleaner by encapsulating
redundant code into functions. I also modifed the scripts where there
was sloppy or unhandled coding causing errors. Put all that together
and what you have below is nowhere near the scripts I started with.
Oh yeah...

This class is for reading ID3v2 tags from MP3 files into an array that
can then be dumped to an Excel spreadsheet (for example) or any other
writeable format you choose. It's purpose, of course, is mainly for
quickly cataloging your MP3 collections in Excel, which can in turn be
imported into Access if you wanted to. It's intended to be used in
Excel so I take no fault if it doesn't work outside of that
environment. If you have any questions, feel free to email me
directly as I don't always have time to monitor my newsgroup posts.
crferguson addtheatsymbol gmail dot com.

==============================
Option Explicit

Private bTemp As Byte, bVersion As Byte
Private sTags As String

'field names
Private TitleField As String
Private ArtistField As String
Private AlbumField As String
Private YearField As String
Private GenreField As String
Private FieldSize As Long
Private SizeOffset As Long
Private FieldOffset As Long
Private TrackNbr As String
Private SituationField As String

Private arrTags(1 To 6, 1 To 2), arrFields(1 To 8)

Public Function GetID3v2Tags(ByVal FileName As String) As Variant
On Error GoTo SendError

Dim iFN As Integer
Dim lHeaderPos As Long
Dim lFileSize As Long

arrTags(1, 1) = "Title"
arrTags(2, 1) = "Artist"
arrTags(3, 1) = "Album"
arrTags(4, 1) = "Year"
arrTags(5, 1) = "Genre"
arrTags(6, 1) = "Track #"

iFN = FreeFile
Open FileName For Binary As iFN
lFileSize = LOF(iFN)

'Check for a Header
Get iFN, 1, bTemp

If bTemp < 255 And bTemp < 73 Then
Exit Function
End If

lHeaderPos = 1
Get iFN, 2, bTemp
If Not (bTemp = 250 Or bTemp = 251) Then
If bTemp = 68 Then
Get iFN, 3, bTemp
If bTemp = 51 Then
Dim lX As Currency
Get iFN, 4, bVersion
Get iFN, 7, bTemp
lX = bTemp * 20917152
Get iFN, 8, bTemp
lX = lX + (CLng(bTemp) * 16384)
Get iFN, 9, bTemp
lX = lX + (bTemp * 128)
Get iFN, 10, bTemp
lX = lX + bTemp
If (lX lFileSize Or lX 2147483647) Then
Exit Function
End If
sTags = Space$(lX)
Get iFN, 11, sTags
lHeaderPos = lX + 11
End If
End If
End If

If Not sTags = "" Then
ParseTags
GetID3v2Tags = arrTags
End If

ClearObjects:
Close iFN
Erase arrTags
Exit Function

SendError:
Dim sMsg As String
sMsg = "An error occured in GetID3v2Tags:" & vbNewLine & vbNewLine
& _
"File: " & FileName & vbNewLine & _
"Error Number: " & Err.Number & vbNewLine & _
"Description: " & Err.Description
Debug.Print sMsg
Err.Clear
GoTo ClearObjects
End Function

Private Sub ParseTags()
On Error GoTo SendError

Dim dX As Double

SetFieldNames bVersion

For dX = 1 To 6
arrTags(dX, 2) = GetAttribute(arrFields(dX))
Next

ClearObjects:
Exit Sub

SendError:
MsgBox "An error occured in ParseTags:" & vbNewLine & vbNewLine &
_
"Error Number: " & Err.Number & vbNewLine & _
"Description: " & Err.Description
Err.Clear
GoTo ClearObjects
End Sub

Private Sub SetFieldNames(ByVal Version)
Select Case Version
Case 2 'ID3v2.2
arrFields(1) = "TT2" 'title field
arrFields(2) = "TOA" 'artist field
arrFields(3) = "TAL" 'album field
arrFields(4) = "TYE" 'year field
arrFields(5) = "TCO" 'genre field
arrFields(6) = "TRCK" 'track number
FieldOffset = 7 'fieldoffset
SizeOffset = 5 'size of offset
Case 3 'ID3v2.3
arrFields(1) = "TIT2" 'title field
arrFields(2) = "TPE1" 'artist field
arrFields(3) = "TALB" 'album field
arrFields(4) = "TYER" 'year field
arrFields(5) = "TCON" 'genre field
arrFields(6) = "TRCK" 'track number
FieldOffset = 11 'fieldoffset
SizeOffset = 7 'size of offset
Case Else
Exit Sub
End Select
End Sub

Private Function GetAttribute(ByVal AttributeName As String) As String
Dim dX As Double, sTemp As String

dX = InStr(sTags, AttributeName)
If dX 0 Then
'read the attribute
FieldSize = Asc(Mid(sTags, dX + SizeOffset)) - 1
If bVersion = 3 Then
'check for compressed or encrypted field
bTemp = Asc(Mid(sTags, dX + 9))
If (bTemp And 128) = 128 Or (bTemp And 64) = 64 Then
GetAttribute = ""
End If
End If
sTemp = Mid(sTags, dX + FieldOffset, FieldSize)

'check if parsing genre tag
If Mid(AttributeName, 1, 3) = "TCO" Then
If Left$(sTemp, 1) = "(" Then
sTemp = Val(Mid$(sTemp, 2, 2))
End If
End If

'set resulting attribute value
GetAttribute = sTemp
End If
End Function

'Private Sub Usage()
' 'this sub is just a sample on how to use the
' 'ID3 tag reading class. The ID3 reader class
' 'returns an array of the tags to a variant variable.
' 'This assumes you named your class module "ID3v2Reader"
'
' Dim ir As ID3v2Reader
' Dim vTemp As Variant
'
' Set ir = New ID3v2Reader
' vTemp = ir.GetID3v2Tags("C:\MyFile.mp3")
'
'End Sub
==================================

Hope this helps someone. I found it difficult to find good info on
doing this in VBA. Also, I developed this on Windows Vista / Office
2007, but I'm fairly certain there's nothing in it that would cause a
problem in previous versions.

Thanks,

Cory

On Dec 15, 4:25 am, Maurizio Masini wrote:
Hi. I got an excel version of my moodlogic classification and wanted to set the Mood tag for my mp3 collection.
You code works fine for what is there, but when i tried to add the TMOO Mood tag, it is not recognised...

Any clue how ? the sTAgs string shouldn't contain the TMOO tag marker ?

Ciao and thanks!

EggHeadCafe - .NET Developer Portal of Choicehttp://www.eggheadcafe.com

Hello there! Yes, sTags contains everything in the tag portion of the
mp3 file. If TMOO is a valid tag in your mp3 file then it should be
in there as well. You can add a line "Debug.Print sTags" immediately
after "sTags = Space$(lX)" and it will print out the actual tag data
string to the immediate window (Ctrl + G in the VBE). Look for your
tag in there. Take care!

On Dec 15, 4:25 am, Maurizio Masini wrote:
Hi. I got an excel version of my moodlogic classification and wanted to set the Mood tag for my mp3 collection.
You code works fine for what is there, but when i tried to add the TMOO Mood tag, it is not recognised...

Any clue how ? the sTAgs string shouldn't contain the TMOO tag marker ?

Ciao and thanks!

EggHeadCafe - .NET Developer Portal of Choicehttp://www.eggheadcafe.com

Hello again! I should've dug a little more deep into your questions
because I think I don't think I answered them completely correct....

The TMOO mood tag is actually and implementation of ID3v2.4 instead
v2.2 or v2.3 which is what I created the class for. Version 2.4 isn't
actually out of beta yet so I felt there was little reason to add in
those tags. However, even with that said, looking at the
documentation for v2.4 (http://www.id3.org/id3v2.4.0-structure) it
might be possible to detect the TMOO tag so long as it's included in
the bytes being scanned by my class.

I had told you to add a Debug.Print right after the sTags = Space$(lX)
line, but it really needs to be added after the next line after that
(Get iFN, 11, sTags). That will show you the entire contents of the
tag bytes in plain text. In that string there will be a ton of
encoded info, but the tags themselves are in plain text. You can add
the TMOO tag fairly easily into my class by just increasing the
arrTags and arrFields arrays by one. Then add the new field where the
field names are set in the code.

You've probably already figured all this out on your own, but I
thought I'd do a little cleanup just in case.

Thanks,

Cory