Wil Moosa
Well-known Member
- Joined
- Aug 11, 2002
- Messages
- 893
I took some code from Nate and Ivan... and tried to adjust the code a bit to my needs. So far unsuccesfully.
The original code shows all files in a directory wíth all the properties/ID tag information in seperate columns. See: http://www.mrexcel.com/board2/viewtopic.php?t=65195&highlight=uid3v2+mp3readid3v2tag+filename+nsize
The needed code should show the properties/ID tag information from just one file... in seperate rows. As you can see I did make a start but it is not working properly. The adjustments made can be found in Sub Properties_MP3_Show_Single().
Can anyone help me here?
Option Explicit
'// Amendment and Translation
'// by Ivan F Moala
'// 5th October 2003
'// Credit:http://www.vbarchiv.net/archiv/tipp_details.php?pid=676
'// Comments NateO
'I also changed:
'sString = Replace(sString, vbNullChar, "") to:
'sString = Replace(sString, vbNullChar, vbNullString)
'In the trimnull function, as this is simply better practice.
'Did a little translating, but it seems fairly obvious...
'I did not cut this code line by line, briefly studied and
'tested at a bare minimum, looks functional. Hope this helps.
'_________________
'Regards,
'Nate Oliver
Public Type mp3Info
Header As String * 3
Title As String * 30
Artist As String * 30
Album As String * 30
Year As String * 4
Comment As String * 30
Genre As Byte
End Type
Public Type ID3v2
sTitle As String
sArtist As String
sAlbum As String
sComment As String
sYear As String
sGenre As String
sComposer As String
sURL As String
sOrgArtist As String
sCopyright As String
sEncodeBy As String
sTrack As String
sMedium As String
sLen As String
End Type
Sub Properties_MP3_Show_Single()
Dim mp3ID As mp3Info
Rem Dim StrFilename As Long
Dim strDir As String
Dim Filename As String
Dim uID3v2 As ID3v2, nSize As Long
Dim oFS As Object
Dim fso
Application.ScreenUpdating = False
'Kopieer actieve cel naar cel A3 op sheet Flags
Selection.Copy
Sheets("Flags").Select
Range("A3").Select
ActiveSheet.Paste
'Sheet 2 opmaken
Rem Application.Run "Properties_MP3_layout"
Sheets("Flags").Select
Range("A3").Select
Filename = ActiveCell.Value ' change to match the file w/Path
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(Filename) Then
On Error Resume Next
ChDir "C:"
On Error GoTo 0
Filename = Application.GetOpenFilename
[Flags!A3].Value = Filename
End If
'Put your filename here
Filename = ActiveCell.Value
'Go to sheet2
Sheets("Sheet2").Select
Filename = FreeFile
'On Error Resume Next
'// MP3 V2 Tag info Exist?
nSize = MP3_ID3v2Exists(Filename)
If nSize > 0 Then
uID3v2 = MP3_ReadID3v2Tag(Filename, nSize)
With uID3v2
[Sheet2!C2"] = .sTitle
[Sheet2!C3"] = .sArtist
[Sheet2!C4"] = .sAlbum
[Sheet2!C5"] = .sTrack
[Sheet2!C6"] = .sLen
[Sheet2!C7"] = .sMedium
[Sheet2!C9"] = .sGenre
End With
Else
Open ("D:\Audio\MP3_Pop\2 Unlimited - No Limit.mp3") For Binary As Filename
Get Filename, LOF(1) - 127, mp3ID
Close Filename
If mp3ID.Header = "TAG" Then
Rem [A1].Offset(lngRow + NextRow, 0) = .FoundFiles(lngFileCnt)
With mp3ID
'.Dir .Title.Artist.Album Track Length Medium .Year .Genre .Comment
[Sheet2!C2"] = .Title
[Sheet2!C3"] = .Artist
[Sheet2!C4"] = .Album
'// NB: year is next col NOT 4 = Track
[Sheet2!C8"] = .Year
[Sheet2!C9"] = GetGenre(.Genre)
[Sheet2!C10"] = .Comment
End With
End If
End If
Application.ScreenUpdating = True
End Sub
Sub Properties_MP3_layout()
'Ga naar sheet2
Sheets("Sheet2").Select
'Gehele sheetopmaak wissen
Columns("A:B").Select
Selection.Clear
Columns("B:B").Select
Selection.ClearFormats
Columns("A:A").ColumnWidth = 2.57
Columns("B:B").ColumnWidth = 25.29
Columns("C:C").ColumnWidth = 45.29
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("B1").Select
Selection.Font.Bold = True
Range("B1:C1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("B8").Select
Selection.Font.Bold = True
Range("B8:C8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("B12").Select
Selection.Font.Bold = True
Range("B12:C12").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("B15").Select
Selection.Font.Bold = True
Range("B15:C15").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("A1").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "Muziek"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Titel van het album"
Range("B3").Select
ActiveCell.FormulaR1C1 = "Jaar"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Nummer"
Range("B5").Select
ActiveCell.FormulaR1C1 = "Genre"
Range("B6").Select
ActiveCell.FormulaR1C1 = "Songteksten"
Range("B8").Select
ActiveCell.FormulaR1C1 = "Beschrijving"
Range("B9").Select
ActiveCell.FormulaR1C1 = "Titel"
Range("B10").Select
ActiveCell.FormulaR1C1 = "Opmerkingen"
Range("B12").Select
ActiveCell.FormulaR1C1 = "Oorsprong"
Range("B13").Select
ActiveCell.FormulaR1C1 = "Beveiligd"
Range("B15").Select
ActiveCell.FormulaR1C1 = "Audio"
Range("B16").Select
ActiveCell.FormulaR1C1 = "Duur"
Range("B17").Select
ActiveCell.FormulaR1C1 = "Bitverwerkingssnelheid"
Range("B18").Select
ActiveCell.FormulaR1C1 = "Kanalen"
Range("B19").Select
ActiveCell.FormulaR1C1 = "Geluidsopnamesnelheid"
Range("A1").Select
End Sub
'// Test wheather a MP3-File has ID3v2-Infos
'// Return value:= length of the ID3v2-Tags as Long
Public Function MP3_ID3v2Exists(ByVal sFile As String) As Long
Dim sText As String
Dim sBin As String
Dim sID3 As String * 3
Dim i As Integer
Dim z As Integer
Dim b(4) As Byte
Dim F As Integer
Dim nID3v2Size As Long
'// Open File
On Error GoTo ErrHandler
F = FreeFile
Open sFile For Binary As #F
Get #F, 1, sID3
If sID3 <> "ID3" Then
MP3_ID3v2Exists = 0
Close #F
Exit Function
End If
'// Determine size of the ID3v2-Tags
Get #F, 7, b(4)
Get #F, 8, b(3)
Get #F, 9, b(2)
Get #F, 10, b(1)
sBin = ""
For z = 2 To 4
For i = 0 To 6
sBin = sBin & CStr(Abs(b(z) And (2 ^ i)))
Next i
Next z
nID3v2Size = 0
For i = 7 To 27
nID3v2Size = nID3v2Size + ((2 ^ i) * Val(Mid(sBin, i - 6, 1)))
Next i
nID3v2Size = nID3v2Size + b(1) + 10
MP3_ID3v2Exists = nID3v2Size
Close #F
Exit Function
ErrHandler:
If F > 0 Then Close #F
MP3_ID3v2Exists = 0
End Function
' Get ID3v2-Info
Public Function MP3_ReadID3v2Tag( _
ByVal sFile As String, _
ByVal nID3v2Size As Long) As ID3v2
Dim nPos As Long
Dim sFrameType As String * 4
Dim sText As String
Dim sBin As String
Dim sID3 As String * 3
Dim i As Integer
Dim z As Integer
Dim b(4) As Byte
Dim F As Integer
Dim nSize As Long
On Error GoTo ErrHandler
'// Open the File
F = FreeFile
Open sFile For Binary As #F
'// Start-Position
nPos = 11
'// Reads the FrameType until it nothing
Do While nPos < nID3v2Size
'// Read in the FrameType Info
Get #F, nPos, sFrameType
If InStr(sFrameType, Chr$(0)) > 0 Then
'// No more data so close it
Close #F
Exit Do
End If
nPos = nPos + 4
Get #F, nPos, b(4) ' FrameType size
Get #F, nPos + 1, b(3) ' FrameType size
Get #F, nPos + 2, b(2) ' FrameType size
Get #F, nPos + 3, b(1) ' FrameType size
nPos = nPos + 5
sBin = ""
For z = 2 To 4
For i = 0 To 7 Step 1
sBin = sBin & CStr(Abs(b(z) And (2 ^ i)))
Next i
Next z
' Calculate FrameType size
nSize = 0
For i = 8 To 30
nSize = nSize + ((2 ^ i) * Val(Mid$(sBin, i - 7, 1)))
Next i
nSize = nSize + b(1)
'// ID3v2-Info
sText = String$(nSize, vbNullChar)
nPos = nPos + 1
Get #F, nPos, sText
sText = TrimNullChar(sText)
With MP3_ReadID3v2Tag
Select Case sFrameType
Case "TMED"
.sMedium = sText
Case "TLEN"
.sLen = sText
Case "TRCK"
.sTrack = sText
Case "TENC"
.sEncodeBy = sText
Case "WXXX"
.sURL = sText
Case "TCOP"
.sCopyright = sText
Case "TOPE"
.sOrgArtist = sText
Case "TCOM"
.sComposer = sText
Case "COMM"
.sComment = sText
Case "TCON"
sText = Replace(sText, "(", "")
sText = Replace(sText, ")", "")
.sGenre = sText
Case "TYER"
.sYear = sText
Case "TALB"
.sAlbum = sText
Case "TPE1"
.sArtist = sText
Case "TIT2"
.sTitle = sText
End Select
nPos = nPos + nSize
End With
Loop
ErrHandler:
Close #F
End Function
Public Function TrimNullChar(ByVal sString As String) As String
sString = Replace(sString, vbNullChar, vbNullString)
TrimNullChar = Trim$(sString)
End Function
Function BrowseForFolderShell() As String
Dim objShell As Object
Dim objFolder As Object
Set objShell = CreateObject("Shell.Application")
'oFolder = Shell.BrowseForFolder(Hwnd, sTitle, iOptions [, vRootFolder])
Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, 0)
If (Not objFolder Is Nothing) Then
'// NB: If SpecFolder= 0 = Desktop then ....
On Error Resume Next
If IsError(objFolder.Items.Item.Path) Then BrowseForFolderShell = CStr(objFolder): GoTo Here
On Error GoTo 0
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.Path) > 3 Then
BrowseForFolderShell = objFolder.Items.Item.Path & Application.PathSeparator
Else
BrowseForFolderShell = objFolder.Items.Item.Path
End If
Else
MsgBox "User cancelled": End
End If
Here:
'MsgBox "You selected:= " & BrowseForFolderShell, vbInformation, "ObjectFolder:= " & objFolder
Set objFolder = Nothing
Set objShell = Nothing
End Function
Function GetGenre(Gen As Byte) As String
Select Case Gen
Case 0: GetGenre = "Blues"
Case 1: GetGenre = "Classic Rock"
Case 2: GetGenre = "Country"
Case 3: GetGenre = "Dance"
Case 4: GetGenre = "Disco"
Case 5: GetGenre = "Funk"
Case 6: GetGenre = "Grunge"
Case 7: GetGenre = "Hip Hop"
Case 8: GetGenre = "Jazz"
Case 9: GetGenre = "Metal"
Case 10: GetGenre = "New Age"
Case 11: GetGenre = "Oldies"
Case 12: GetGenre = "Other"
Case 13: GetGenre = "Pop"
Case 14: GetGenre = "R&B"
Case 15: GetGenre = "Rap"
Case 16: GetGenre = "Reggae"
Case 17: GetGenre = "Rock"
Case 18: GetGenre = "Techno"
Case 19: GetGenre = "Industrial"
Case 20: GetGenre = "Alternative"
Case 21: GetGenre = "Ska"
Case 22: GetGenre = "Death Metal"
Case 23: GetGenre = "Pranks"
Case 24: GetGenre = "Soundtrack"
Case 25: GetGenre = "Euro - Techno"
Case 26: GetGenre = "Ambient"
Case 27: GetGenre = "Trip Hop"
Case 28: GetGenre = "Vocal"
Case 29: GetGenre = "Jazz - Funk"
Case 30: GetGenre = "Fusion"
Case 31: GetGenre = "Trance"
Case 32: GetGenre = "Classical"
Case 33: GetGenre = "Instrumental"
Case 34: GetGenre = "Acid"
Case 35: GetGenre = "House"
Case 36: GetGenre = "Game"
Case 37: GetGenre = "Sound Clip"
Case 38: GetGenre = "Gospel"
Case 39: GetGenre = "Noise"
Case 40: GetGenre = "Alt.Rock"
Case 41: GetGenre = "Bass"
Case 42: GetGenre = "Soul"
Case 43: GetGenre = "Punk"
Case 44: GetGenre = "Space"
Case 45: GetGenre = "Meditative"
Case 46: GetGenre = "Instrumental Pop"
Case 47: GetGenre = "Instrumental Rock"
Case 48: GetGenre = "Ethnic"
Case 49: GetGenre = "Gothic"
Case 50: GetGenre = "Darkwave"
Case 51: GetGenre = "Techno - Industrial"
Case 52: GetGenre = "Electronic"
Case 53: GetGenre = "Pop / Folk"
Case 54: GetGenre = "Eurodance"
Case 55: GetGenre = "Dream"
Case 56: GetGenre = "Southern Rock"
Case 57: GetGenre = "Comedy"
Case 58: GetGenre = "Cult"
Case 59: GetGenre = "Gangsta Rap"
Case 60: GetGenre = "Top 40"
Case 61: GetGenre = "Christian Rap"
Case 62: GetGenre = "Pop / Funk"
Case 63: GetGenre = "Jungle"
Case 64: GetGenre = "Native American"
Case 65: GetGenre = "Cabaret"
Case 66: GetGenre = "New Wave"
Case 67: GetGenre = "Psychedelic"
Case 68: GetGenre = "Rave"
Case 69: GetGenre = "Showtunes"
Case 70: GetGenre = "Trailer"
Case 71: GetGenre = "Lo - fi"
Case 72: GetGenre = "Tribal"
Case 73: GetGenre = "Acid Punk"
Case 74: GetGenre = "Acid Jazz"
Case 75: GetGenre = "Polka"
Case 76: GetGenre = "Retro"
Case 77: GetGenre = "Musical"
Case 78: GetGenre = "Rock 'n'Roll"
Case 79: GetGenre = "Hard Rock"
'// 80 onwardsare WinAmp extentions
Case 80: GetGenre = "Folk"
Case 81: GetGenre = "Folk / Rock"
Case 82: GetGenre = "National Folk"
Case 83: GetGenre = "Swing"
Case 84: GetGenre = "Fast Fusion"
Case 85: GetGenre = "Bebob"
Case 86: GetGenre = "Latin"
Case 87: GetGenre = "Revival"
Case 88: GetGenre = "Celtic"
Case 89: GetGenre = "Blue Grass"
Case 90: GetGenre = "Avant Garde"
Case 91: GetGenre = "Gothic Rock"
Case 92: GetGenre = "Progressive Rock"
Case 93: GetGenre = "Psychedelic Rock"
Case 94: GetGenre = "Symphonic Rock"
Case 95: GetGenre = "Slow Rock"
Case 96: GetGenre = "Big Band"
Case 97: GetGenre = "Chorus"
Case 98: GetGenre = "Easy Listening"
Case 99: GetGenre = "Acoustic"
Case 100: GetGenre = "Humour"
Case 101: GetGenre = "Speech"
Case 102: GetGenre = "Chanson"
Case 103: GetGenre = "Opera"
Case 104: GetGenre = "Chamber Music"
Case 105: GetGenre = "Sonata"
Case 106: GetGenre = "Symphony"
Case 107: GetGenre = "Booty Bass"
Case 108: GetGenre = "Primus"
Case 109: GetGenre = "**** Groove"
Case 110: GetGenre = "Satire"
Case 111: GetGenre = "Slow Jam"
Case 112: GetGenre = "Club"
Case 113: GetGenre = "Tango"
Case 114: GetGenre = "Samba"
Case 115: GetGenre = "Folklore"
Case 116: GetGenre = "Ballad"
Case 117: GetGenre = "Power Ballad"
Case 118: GetGenre = "Rhythmic Soul"
Case 119: GetGenre = "Freestyle"
Case 120: GetGenre = "Duet"
Case 121: GetGenre = "Punk Rock"
Case 122: GetGenre = "Drum Solo"
Case 124: GetGenre = "Euro - House"
Case 125: GetGenre = "Dance Hall"
Case 126: GetGenre = "Goa"
Case 127: GetGenre = "Drum & Bass"
Case 128: GetGenre = "Club - House"
Case 129: GetGenre = "Hardcore"
Case 130: GetGenre = "Terror"
Case 131: GetGenre = "Indie"
Case 132: GetGenre = "Brit Pop"
Case 133: GetGenre = "Negerpunk"
Case 134: GetGenre = "Polsk Punk"
Case 135: GetGenre = "Beat"
Case 136: GetGenre = "Christian Gangsta Rap"
Case 137: GetGenre = "Heavy Metal"
Case 138: GetGenre = "Black Metal"
Case 139: GetGenre = "Crossover"
Case 140: GetGenre = "Contemporary Christian"
Case 141: GetGenre = "Christian Rock"
Case 142: GetGenre = "Merengue"
Case 143: GetGenre = "Salsa"
Case 144: GetGenre = "Thrash Metal"
Case 145: GetGenre = "Anime"
Case 146: GetGenre = "JPop"
Case 147: GetGenre = "Synth Pop"
Case 255: GetGenre = "Not Defined"
Case Else: GetGenre = "No Constant for " & Gen
End Select
End Function
The original code shows all files in a directory wíth all the properties/ID tag information in seperate columns. See: http://www.mrexcel.com/board2/viewtopic.php?t=65195&highlight=uid3v2+mp3readid3v2tag+filename+nsize
The needed code should show the properties/ID tag information from just one file... in seperate rows. As you can see I did make a start but it is not working properly. The adjustments made can be found in Sub Properties_MP3_Show_Single().
Can anyone help me here?
Option Explicit
'// Amendment and Translation
'// by Ivan F Moala
'// 5th October 2003
'// Credit:http://www.vbarchiv.net/archiv/tipp_details.php?pid=676
'// Comments NateO
'I also changed:
'sString = Replace(sString, vbNullChar, "") to:
'sString = Replace(sString, vbNullChar, vbNullString)
'In the trimnull function, as this is simply better practice.
'Did a little translating, but it seems fairly obvious...
'I did not cut this code line by line, briefly studied and
'tested at a bare minimum, looks functional. Hope this helps.
'_________________
'Regards,
'Nate Oliver
Public Type mp3Info
Header As String * 3
Title As String * 30
Artist As String * 30
Album As String * 30
Year As String * 4
Comment As String * 30
Genre As Byte
End Type
Public Type ID3v2
sTitle As String
sArtist As String
sAlbum As String
sComment As String
sYear As String
sGenre As String
sComposer As String
sURL As String
sOrgArtist As String
sCopyright As String
sEncodeBy As String
sTrack As String
sMedium As String
sLen As String
End Type
Sub Properties_MP3_Show_Single()
Dim mp3ID As mp3Info
Rem Dim StrFilename As Long
Dim strDir As String
Dim Filename As String
Dim uID3v2 As ID3v2, nSize As Long
Dim oFS As Object
Dim fso
Application.ScreenUpdating = False
'Kopieer actieve cel naar cel A3 op sheet Flags
Selection.Copy
Sheets("Flags").Select
Range("A3").Select
ActiveSheet.Paste
'Sheet 2 opmaken
Rem Application.Run "Properties_MP3_layout"
Sheets("Flags").Select
Range("A3").Select
Filename = ActiveCell.Value ' change to match the file w/Path
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FileExists(Filename) Then
On Error Resume Next
ChDir "C:"
On Error GoTo 0
Filename = Application.GetOpenFilename
[Flags!A3].Value = Filename
End If
'Put your filename here
Filename = ActiveCell.Value
'Go to sheet2
Sheets("Sheet2").Select
Filename = FreeFile
'On Error Resume Next
'// MP3 V2 Tag info Exist?
nSize = MP3_ID3v2Exists(Filename)
If nSize > 0 Then
uID3v2 = MP3_ReadID3v2Tag(Filename, nSize)
With uID3v2
[Sheet2!C2"] = .sTitle
[Sheet2!C3"] = .sArtist
[Sheet2!C4"] = .sAlbum
[Sheet2!C5"] = .sTrack
[Sheet2!C6"] = .sLen
[Sheet2!C7"] = .sMedium
[Sheet2!C9"] = .sGenre
End With
Else
Open ("D:\Audio\MP3_Pop\2 Unlimited - No Limit.mp3") For Binary As Filename
Get Filename, LOF(1) - 127, mp3ID
Close Filename
If mp3ID.Header = "TAG" Then
Rem [A1].Offset(lngRow + NextRow, 0) = .FoundFiles(lngFileCnt)
With mp3ID
'.Dir .Title.Artist.Album Track Length Medium .Year .Genre .Comment
[Sheet2!C2"] = .Title
[Sheet2!C3"] = .Artist
[Sheet2!C4"] = .Album
'// NB: year is next col NOT 4 = Track
[Sheet2!C8"] = .Year
[Sheet2!C9"] = GetGenre(.Genre)
[Sheet2!C10"] = .Comment
End With
End If
End If
Application.ScreenUpdating = True
End Sub
Sub Properties_MP3_layout()
'Ga naar sheet2
Sheets("Sheet2").Select
'Gehele sheetopmaak wissen
Columns("A:B").Select
Selection.Clear
Columns("B:B").Select
Selection.ClearFormats
Columns("A:A").ColumnWidth = 2.57
Columns("B:B").ColumnWidth = 25.29
Columns("C:C").ColumnWidth = 45.29
Columns("B:B").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("B1").Select
Selection.Font.Bold = True
Range("B1:C1").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("B8").Select
Selection.Font.Bold = True
Range("B8:C8").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("B12").Select
Selection.Font.Bold = True
Range("B12:C12").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("B15").Select
Selection.Font.Bold = True
Range("B15:C15").Select
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 3
End With
Range("A1").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "Muziek"
Range("B2").Select
ActiveCell.FormulaR1C1 = "Titel van het album"
Range("B3").Select
ActiveCell.FormulaR1C1 = "Jaar"
Range("B4").Select
ActiveCell.FormulaR1C1 = "Nummer"
Range("B5").Select
ActiveCell.FormulaR1C1 = "Genre"
Range("B6").Select
ActiveCell.FormulaR1C1 = "Songteksten"
Range("B8").Select
ActiveCell.FormulaR1C1 = "Beschrijving"
Range("B9").Select
ActiveCell.FormulaR1C1 = "Titel"
Range("B10").Select
ActiveCell.FormulaR1C1 = "Opmerkingen"
Range("B12").Select
ActiveCell.FormulaR1C1 = "Oorsprong"
Range("B13").Select
ActiveCell.FormulaR1C1 = "Beveiligd"
Range("B15").Select
ActiveCell.FormulaR1C1 = "Audio"
Range("B16").Select
ActiveCell.FormulaR1C1 = "Duur"
Range("B17").Select
ActiveCell.FormulaR1C1 = "Bitverwerkingssnelheid"
Range("B18").Select
ActiveCell.FormulaR1C1 = "Kanalen"
Range("B19").Select
ActiveCell.FormulaR1C1 = "Geluidsopnamesnelheid"
Range("A1").Select
End Sub
'// Test wheather a MP3-File has ID3v2-Infos
'// Return value:= length of the ID3v2-Tags as Long
Public Function MP3_ID3v2Exists(ByVal sFile As String) As Long
Dim sText As String
Dim sBin As String
Dim sID3 As String * 3
Dim i As Integer
Dim z As Integer
Dim b(4) As Byte
Dim F As Integer
Dim nID3v2Size As Long
'// Open File
On Error GoTo ErrHandler
F = FreeFile
Open sFile For Binary As #F
Get #F, 1, sID3
If sID3 <> "ID3" Then
MP3_ID3v2Exists = 0
Close #F
Exit Function
End If
'// Determine size of the ID3v2-Tags
Get #F, 7, b(4)
Get #F, 8, b(3)
Get #F, 9, b(2)
Get #F, 10, b(1)
sBin = ""
For z = 2 To 4
For i = 0 To 6
sBin = sBin & CStr(Abs(b(z) And (2 ^ i)))
Next i
Next z
nID3v2Size = 0
For i = 7 To 27
nID3v2Size = nID3v2Size + ((2 ^ i) * Val(Mid(sBin, i - 6, 1)))
Next i
nID3v2Size = nID3v2Size + b(1) + 10
MP3_ID3v2Exists = nID3v2Size
Close #F
Exit Function
ErrHandler:
If F > 0 Then Close #F
MP3_ID3v2Exists = 0
End Function
' Get ID3v2-Info
Public Function MP3_ReadID3v2Tag( _
ByVal sFile As String, _
ByVal nID3v2Size As Long) As ID3v2
Dim nPos As Long
Dim sFrameType As String * 4
Dim sText As String
Dim sBin As String
Dim sID3 As String * 3
Dim i As Integer
Dim z As Integer
Dim b(4) As Byte
Dim F As Integer
Dim nSize As Long
On Error GoTo ErrHandler
'// Open the File
F = FreeFile
Open sFile For Binary As #F
'// Start-Position
nPos = 11
'// Reads the FrameType until it nothing
Do While nPos < nID3v2Size
'// Read in the FrameType Info
Get #F, nPos, sFrameType
If InStr(sFrameType, Chr$(0)) > 0 Then
'// No more data so close it
Close #F
Exit Do
End If
nPos = nPos + 4
Get #F, nPos, b(4) ' FrameType size
Get #F, nPos + 1, b(3) ' FrameType size
Get #F, nPos + 2, b(2) ' FrameType size
Get #F, nPos + 3, b(1) ' FrameType size
nPos = nPos + 5
sBin = ""
For z = 2 To 4
For i = 0 To 7 Step 1
sBin = sBin & CStr(Abs(b(z) And (2 ^ i)))
Next i
Next z
' Calculate FrameType size
nSize = 0
For i = 8 To 30
nSize = nSize + ((2 ^ i) * Val(Mid$(sBin, i - 7, 1)))
Next i
nSize = nSize + b(1)
'// ID3v2-Info
sText = String$(nSize, vbNullChar)
nPos = nPos + 1
Get #F, nPos, sText
sText = TrimNullChar(sText)
With MP3_ReadID3v2Tag
Select Case sFrameType
Case "TMED"
.sMedium = sText
Case "TLEN"
.sLen = sText
Case "TRCK"
.sTrack = sText
Case "TENC"
.sEncodeBy = sText
Case "WXXX"
.sURL = sText
Case "TCOP"
.sCopyright = sText
Case "TOPE"
.sOrgArtist = sText
Case "TCOM"
.sComposer = sText
Case "COMM"
.sComment = sText
Case "TCON"
sText = Replace(sText, "(", "")
sText = Replace(sText, ")", "")
.sGenre = sText
Case "TYER"
.sYear = sText
Case "TALB"
.sAlbum = sText
Case "TPE1"
.sArtist = sText
Case "TIT2"
.sTitle = sText
End Select
nPos = nPos + nSize
End With
Loop
ErrHandler:
Close #F
End Function
Public Function TrimNullChar(ByVal sString As String) As String
sString = Replace(sString, vbNullChar, vbNullString)
TrimNullChar = Trim$(sString)
End Function
Function BrowseForFolderShell() As String
Dim objShell As Object
Dim objFolder As Object
Set objShell = CreateObject("Shell.Application")
'oFolder = Shell.BrowseForFolder(Hwnd, sTitle, iOptions [, vRootFolder])
Set objFolder = objShell.BrowseForFolder(0, "Please select a folder", 0, 0)
If (Not objFolder Is Nothing) Then
'// NB: If SpecFolder= 0 = Desktop then ....
On Error Resume Next
If IsError(objFolder.Items.Item.Path) Then BrowseForFolderShell = CStr(objFolder): GoTo Here
On Error GoTo 0
'// Is it the Root Dir?...if so change
If Len(objFolder.Items.Item.Path) > 3 Then
BrowseForFolderShell = objFolder.Items.Item.Path & Application.PathSeparator
Else
BrowseForFolderShell = objFolder.Items.Item.Path
End If
Else
MsgBox "User cancelled": End
End If
Here:
'MsgBox "You selected:= " & BrowseForFolderShell, vbInformation, "ObjectFolder:= " & objFolder
Set objFolder = Nothing
Set objShell = Nothing
End Function
Function GetGenre(Gen As Byte) As String
Select Case Gen
Case 0: GetGenre = "Blues"
Case 1: GetGenre = "Classic Rock"
Case 2: GetGenre = "Country"
Case 3: GetGenre = "Dance"
Case 4: GetGenre = "Disco"
Case 5: GetGenre = "Funk"
Case 6: GetGenre = "Grunge"
Case 7: GetGenre = "Hip Hop"
Case 8: GetGenre = "Jazz"
Case 9: GetGenre = "Metal"
Case 10: GetGenre = "New Age"
Case 11: GetGenre = "Oldies"
Case 12: GetGenre = "Other"
Case 13: GetGenre = "Pop"
Case 14: GetGenre = "R&B"
Case 15: GetGenre = "Rap"
Case 16: GetGenre = "Reggae"
Case 17: GetGenre = "Rock"
Case 18: GetGenre = "Techno"
Case 19: GetGenre = "Industrial"
Case 20: GetGenre = "Alternative"
Case 21: GetGenre = "Ska"
Case 22: GetGenre = "Death Metal"
Case 23: GetGenre = "Pranks"
Case 24: GetGenre = "Soundtrack"
Case 25: GetGenre = "Euro - Techno"
Case 26: GetGenre = "Ambient"
Case 27: GetGenre = "Trip Hop"
Case 28: GetGenre = "Vocal"
Case 29: GetGenre = "Jazz - Funk"
Case 30: GetGenre = "Fusion"
Case 31: GetGenre = "Trance"
Case 32: GetGenre = "Classical"
Case 33: GetGenre = "Instrumental"
Case 34: GetGenre = "Acid"
Case 35: GetGenre = "House"
Case 36: GetGenre = "Game"
Case 37: GetGenre = "Sound Clip"
Case 38: GetGenre = "Gospel"
Case 39: GetGenre = "Noise"
Case 40: GetGenre = "Alt.Rock"
Case 41: GetGenre = "Bass"
Case 42: GetGenre = "Soul"
Case 43: GetGenre = "Punk"
Case 44: GetGenre = "Space"
Case 45: GetGenre = "Meditative"
Case 46: GetGenre = "Instrumental Pop"
Case 47: GetGenre = "Instrumental Rock"
Case 48: GetGenre = "Ethnic"
Case 49: GetGenre = "Gothic"
Case 50: GetGenre = "Darkwave"
Case 51: GetGenre = "Techno - Industrial"
Case 52: GetGenre = "Electronic"
Case 53: GetGenre = "Pop / Folk"
Case 54: GetGenre = "Eurodance"
Case 55: GetGenre = "Dream"
Case 56: GetGenre = "Southern Rock"
Case 57: GetGenre = "Comedy"
Case 58: GetGenre = "Cult"
Case 59: GetGenre = "Gangsta Rap"
Case 60: GetGenre = "Top 40"
Case 61: GetGenre = "Christian Rap"
Case 62: GetGenre = "Pop / Funk"
Case 63: GetGenre = "Jungle"
Case 64: GetGenre = "Native American"
Case 65: GetGenre = "Cabaret"
Case 66: GetGenre = "New Wave"
Case 67: GetGenre = "Psychedelic"
Case 68: GetGenre = "Rave"
Case 69: GetGenre = "Showtunes"
Case 70: GetGenre = "Trailer"
Case 71: GetGenre = "Lo - fi"
Case 72: GetGenre = "Tribal"
Case 73: GetGenre = "Acid Punk"
Case 74: GetGenre = "Acid Jazz"
Case 75: GetGenre = "Polka"
Case 76: GetGenre = "Retro"
Case 77: GetGenre = "Musical"
Case 78: GetGenre = "Rock 'n'Roll"
Case 79: GetGenre = "Hard Rock"
'// 80 onwardsare WinAmp extentions
Case 80: GetGenre = "Folk"
Case 81: GetGenre = "Folk / Rock"
Case 82: GetGenre = "National Folk"
Case 83: GetGenre = "Swing"
Case 84: GetGenre = "Fast Fusion"
Case 85: GetGenre = "Bebob"
Case 86: GetGenre = "Latin"
Case 87: GetGenre = "Revival"
Case 88: GetGenre = "Celtic"
Case 89: GetGenre = "Blue Grass"
Case 90: GetGenre = "Avant Garde"
Case 91: GetGenre = "Gothic Rock"
Case 92: GetGenre = "Progressive Rock"
Case 93: GetGenre = "Psychedelic Rock"
Case 94: GetGenre = "Symphonic Rock"
Case 95: GetGenre = "Slow Rock"
Case 96: GetGenre = "Big Band"
Case 97: GetGenre = "Chorus"
Case 98: GetGenre = "Easy Listening"
Case 99: GetGenre = "Acoustic"
Case 100: GetGenre = "Humour"
Case 101: GetGenre = "Speech"
Case 102: GetGenre = "Chanson"
Case 103: GetGenre = "Opera"
Case 104: GetGenre = "Chamber Music"
Case 105: GetGenre = "Sonata"
Case 106: GetGenre = "Symphony"
Case 107: GetGenre = "Booty Bass"
Case 108: GetGenre = "Primus"
Case 109: GetGenre = "**** Groove"
Case 110: GetGenre = "Satire"
Case 111: GetGenre = "Slow Jam"
Case 112: GetGenre = "Club"
Case 113: GetGenre = "Tango"
Case 114: GetGenre = "Samba"
Case 115: GetGenre = "Folklore"
Case 116: GetGenre = "Ballad"
Case 117: GetGenre = "Power Ballad"
Case 118: GetGenre = "Rhythmic Soul"
Case 119: GetGenre = "Freestyle"
Case 120: GetGenre = "Duet"
Case 121: GetGenre = "Punk Rock"
Case 122: GetGenre = "Drum Solo"
Case 124: GetGenre = "Euro - House"
Case 125: GetGenre = "Dance Hall"
Case 126: GetGenre = "Goa"
Case 127: GetGenre = "Drum & Bass"
Case 128: GetGenre = "Club - House"
Case 129: GetGenre = "Hardcore"
Case 130: GetGenre = "Terror"
Case 131: GetGenre = "Indie"
Case 132: GetGenre = "Brit Pop"
Case 133: GetGenre = "Negerpunk"
Case 134: GetGenre = "Polsk Punk"
Case 135: GetGenre = "Beat"
Case 136: GetGenre = "Christian Gangsta Rap"
Case 137: GetGenre = "Heavy Metal"
Case 138: GetGenre = "Black Metal"
Case 139: GetGenre = "Crossover"
Case 140: GetGenre = "Contemporary Christian"
Case 141: GetGenre = "Christian Rock"
Case 142: GetGenre = "Merengue"
Case 143: GetGenre = "Salsa"
Case 144: GetGenre = "Thrash Metal"
Case 145: GetGenre = "Anime"
Case 146: GetGenre = "JPop"
Case 147: GetGenre = "Synth Pop"
Case 255: GetGenre = "Not Defined"
Case Else: GetGenre = "No Constant for " & Gen
End Select
End Function
