New MP3 question

[chefwarren]

Hi All,

Me again. I am just addicted to this site. So here is my newest challenge. I have searched through the archives and have not found exactly what I am looking for so new post.

I would like to create an excell list of all my music.

My music is stored on an external hard drives in one master folder called aptly my music, and hundreds of folders within by artist name. Some of those folders have further folders that are Album title, finally files stored within.

Is there away to run a macro that will search each folder, find the files, extract the atist name, song title, album etc.

Kindly,

Warren

 

[Glove_Man]

Here is some code I wrote to rename every folder in a file. You should be able to use some of the main elements to create what you want...

But I don't have any MP3 files here so I don't know how to call back the information....

Option Explicit
Option Base 1
Option Compare Text

Public FSO As New FileSystemObject


Sub RenameTheFiles()

Dim pathname As String

pathname = "G:\1616_BPA\Strategy\Weekly Strategy Publications\"

Dim myFile As File
Dim myFolder As Folder

Set myFolder = FSO.GetFolder(pathname)

For Each myFile In myFolder.Files

    If Len(myFile.Name) = 12 Then
        myFile.Name = "Strategy Weekly " & myFile.Name
    End If

Next myFile


End Sub

 

[Andrew Fergus]

Hi Warren

I have tested this using Excel 2003 on Windows XP and it seemed to work ok. In my tests I realised I had a lot of songs where the artist, album, year etc has not been assigned to each song so I also pulled through the folder name and that folders parent folder name, in case you want to copy these values across.

Create a new spreadsheet with the following titles in the first 9 columns:
File Name
File Location
Song Name
Artist
Album
Year
Format
Folder
Parent Folder

You might also want to set up an autofilter on the first row.

Notes:
1) you will need to set a reference to 'Microsoft Scripting Runtime' under VBE menu option Tools > References
2) set the name of the worksheet where you want the results stored with the constant 'MyOutputSheet'
3) set the name of the drive/directory you want to search with the constant 'MyStartFolder'
4) copy/paste the following code into the 'This Workbook' module of your spreadsheet:

Option Explicit
'____________________________________________________________
'
'Written by Andrew Fergus 10 September 2007
'Set a reference to 'Microsoft Scripting Runtime' under VBE
'   menu option Tools > References
'____________________________________________________________

Private Type TagInformation 'assumes ID3 format
    Tag As String * 3
    SongName As String * 30
    Artist As String * 30
    Album As String * 30
    Year As String * 4
    Comment As String * 30
    Genre As String * 1
End Type

Public RowCount As Long
Public ColumnCount As Long

'SET THE DRIVE / FOLDER TO SEARCH HERE
Const MyStartFolder As String = "E:\MyFiles\Music"
'SET THE WORKSHEET NAME TO HOLD THE RESULTS HERE
Const MyOutputSheet As String = "Sheet1"

Public Sub GetMyList()
'This is the macro you run from menu option Tools > Macros

RowCount = 1
ColumnCount = 1

Application.Cursor = xlWait
RetrieveSongs (MyStartFolder)

Application.Cursor = xlDefault
MsgBox "Finished compiling song list.", vbInformation, "Done!"

End Sub


Sub RetrieveSongs(Location As String)

On Error GoTo ErrorHandler

Dim fso As New FileSystemObject
Dim fsoFile As File
Dim fsoFolder As Folder
Dim FileTag As TagInformation

'Search this folder for files
For Each fsoFile In fso.GetFolder(Location).Files
    If LCase(Right$(fsoFile.Name, 3)) = "mp3" Or _
    LCase(Right$(fsoFile.Name, 3)) = "wma" Then
        Open fsoFile.Path For Binary As #1
        With FileTag
            Get #1, FileLen(fsoFile.Path) - 127, .Tag
            If UCase(.Tag) = "TAG" Then
                Get #1, , .SongName
                Get #1, , .Artist
                Get #1, , .Album
                Get #1, , .Year
                Call WriteSong(fsoFile.Name, _
                        fsoFile.parentfolder, _
                        RTrim(.SongName), _
                        RTrim(.Artist), _
                        RTrim(.Album), _
                        RTrim(.Year))
            Else
                Call WriteSong(fsoFile.Name, _
                        fsoFile.parentfolder)
            End If
        End With
        Close #1
    End If
Next

'Search this folder for more folders
For Each fsoFolder In fso.GetFolder(Location).SubFolders
    Call RetrieveSongs(fsoFolder.Path)
Next

Exit_Here:
    Set fsoFile = Nothing
    Set fsoFolder = Nothing
    Set fso = Nothing
    Exit Sub

ErrorHandler:
    Application.Cursor = xlDefault
    Close #1
    MsgBox "There was an unexpected error." & vbCrLf & _
    Err.Description, vbCritical, "Error# " & Err.Number
    GoTo Exit_Here

End Sub

Sub WriteSong(filename As String, _
    filefolder As String, _
    Optional MySongName As String, _
    Optional MySongArtist As String, _
    Optional MySongAlbum As String, _
    Optional MySongYear As String)

Dim tmpString As String

If RowCount = 65536 Then
    RowCount = 2
    ColumnCount = ColumnCount + 11
Else
    RowCount = RowCount + 1
End If

With Sheets(MyOutputSheet)
    .Cells(RowCount, ColumnCount).Value = filename 'file name
    .Cells(RowCount, ColumnCount + 1).Value = filefolder 'file location
    .Cells(RowCount, ColumnCount + 2).Value = "'" & MySongName
    .Cells(RowCount, ColumnCount + 3).Value = "'" & MySongArtist
    .Cells(RowCount, ColumnCount + 4).Value = "'" & MySongAlbum
    .Cells(RowCount, ColumnCount + 5).Value = "'" & MySongYear
    tmpString = "'" & LCase(Right$(filename, 3))
    .Cells(RowCount, ColumnCount + 6).Value = tmpString 'type
    If InStr(1, filefolder, "\", vbTextCompare) > 1 Then
        tmpString = "'" & Right$(filefolder, InStr(1, StrReverse(filefolder), "\", vbTextCompare) - 1)
    End If
    .Cells(RowCount, ColumnCount + 7).Value = tmpString 'folder
    If InStr(1 + InStr(1, filefolder, "\", vbTextCompare), filefolder, "\", vbTextCompare) > 1 Then
        tmpString = Left$(filefolder, Len(filefolder) - InStr(1, StrReverse(filefolder), "\", vbTextCompare))
        tmpString = "'" & Right$(tmpString, InStr(1, StrReverse(tmpString), "\", vbTextCompare) - 1)
    End If
    .Cells(RowCount, ColumnCount + 8).Value = tmpString 'parent folder
End With
    
End Sub

Enjoy!
Andrew

 

[njimack]

It looks like your request has been solved, but this link may be useful...

http://j-walk.com/ss/excel/tips/MP3SongLister.exe

 

[Andrew Fergus]

Apparently the ID3 file format is either changing or is no longer reliable (or something - see here.) Following is a simpler version which draws on the Windows properties (I'm not sure if this is related to ID3 or not). Notice it doesn't have any error handling (you may want to amend for that). No VBE references are required for this one, and the headings in the spreadsheet can be derived from the code. It also doesn't provide the folder name or the folders parent folder name - but that could probably be derived using a formula or modifying the code per my previous post.

Option Explicit
'____________________________________________________________
'
'Written by Andrew Fergus 10 September 2007
'____________________________________________________________

Public RowCount As Long

'SET THE DRIVE / FOLDER TO SEARCH HERE
Const MyStartFolder As String = "E:\MyMusicFiles\Music"
'SET THE WORKSHEET NAME TO HOLD THE RESULTS HERE
Const MyOutputSheet2 As String = "Sheet2"

Public Sub GetMyListOfMusic()

RowCount = 1
With Application.FileSearch
    .NewSearch
    .LookIn = MyStartFolder
    .SearchSubFolders = True
    .FileType = msoFileTypeAllFiles
    .Execute
    If .FoundFiles.Count > 0 Then
        GetMySongs (MyStartFolder)
    Else
        MsgBox "There were no files in that directory!", vbCritical, "Error"
    End If
End With

MsgBox "Finished creating file list!", vbInformation, "Done!"

End Sub

Sub GetMySongs(TargetDir As Variant)

Dim objShell As Object
Dim objFolder As Object
Dim strFileName As Variant

Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(TargetDir)

For Each strFileName In objFolder.Items
    If objFolder.GetDetailsOf(strFileName, 2) = "File Folder" Then
        GetMySongs (TargetDir & "\" & objFolder.GetDetailsOf(strFileName, 0))
    Else
        RowCount = RowCount + 1
        With Worksheets(MyOutputSheet2)
            'File Name
            .Cells(RowCount, 1) = objFolder.GetDetailsOf(strFileName, 0)
            'Location
            .Cells(RowCount, 2) = TargetDir
            'Artist
            .Cells(RowCount, 3) = objFolder.GetDetailsOf(strFileName, 16)
            'Album
            .Cells(RowCount, 4) = objFolder.GetDetailsOf(strFileName, 17)
            'Year
            .Cells(RowCount, 5) = objFolder.GetDetailsOf(strFileName, 18)
            'Genre
            .Cells(RowCount, 6) = objFolder.GetDetailsOf(strFileName, 20)
            'Track number
            .Cells(RowCount, 7) = objFolder.GetDetailsOf(strFileName, 19)
            'Format
            .Cells(RowCount, 8) = objFolder.GetDetailsOf(strFileName, 2)
        End With
    End If
Next

Set objShell = Nothing
Set objFolder = Nothing

End Sub

Andrew

 

[chefwarren]

HI all,

Thanks Andrew. I cant wait to try the code you wrote. Thanks also NJMack for your response. I tried out that little bit of programing in your link. At it worked out great. Of course you noticed who wrote that right. Master Walkenbach. Thats cool.
Andrew I also checked out that link you put up about reading and writing to the mp3 ids. I am going to try that out too. It would be nice to make changes to the id tags also. Very cool stuff.

Thanks a bunch>>> LOVE THIS SITE>

 

[chefwarren]

Thanks

NJMack,

Question for you. Or I guess anyone else who can answer. So far I have tried the solution you gave first. Seemed a bit easier to me.

The only trouble is it only grabs the files that are MP3. It ignores all the WMA files.


Any one have any suggestions.

Warren

 

[Andrew Fergus]

Fully functioning answer provided here : http://www.mrexcel.com/board2/viewtopic.php?p=1405207#1405207

Just ask if you aren't sure how to use it.

 

[sdgenxr]

With Andrew Fergus' solutions, I get an error at the following line of code.

With Application.FileSearch

I like the information that this solution is supposed to provide but get the same error as above.

It looks like your request has been solved, but this link may be useful...

http://j-walk.com/ss/excel/tips/MP3SongLister.exe

Not sure if it matters, but I'm running excel 07 on XP. I read on the above website that I needed to enable shell32.dll under VB resources, but find it grayed out. Any ideas?

TIA

 

[jstiene]

Nice code, Andrew. Fast, effective, simple, efficient.

How about writing to these properties from info stored in the worksheet though? I see someone tried it before with about 20 sendkeys, but that is impractical and dangerous. Any ideas?

IE grabbing the Artist or Album name from the workbook after manually updating and writing it to the files listed in the worksheet?