Produce an Excel list of the attributes of all MP3 files that sit in or below the "My Music" folder.

Published on
13,452 Points
11 Endorsements
Last Modified:
Community Pick


This Article provides Excel VBA that will retrieve the properties for all MP3 files that reside anywhere under the User's My Music folder. The intent of this Article is  to:
1) provide a useful resource for people to catalogue their music collections.
2) present an efficient recursive loop technique for VBA coders given that Microsoft has removed FileSearch Method from VBA in xl2007.
3) show the simplicity that some basic wscript brings when working with the Operating System.

This code is designed to run on an ad-hoc basis by users to compile a report of the MP3 files in that user's "My Music" folder structure at a particular point in time.  Running this automatically - which can be done via scheduling a vbscript - is outside the scope of this Article.

Using the code

  1. Copy the code at the bottom of this Article
   2. Open any workbook.
   3. Press Alt + F11 to open the Visual Basic Editor (VBE).
   4. From the Menu, choose Insert-Module.
   5. Paste the code into the right-hand code window.
   6. Close the VBE, save the file if desired.

   In xl2003 go to Tools-Macro-Macros and double-click Main
   In xl2007 click the Macros button in the Code group  of the Developer tab, then click Main in the list box

Please note that this code must be run from a regular VBA Code Module - else the code will cause an error if users try to run it from the ThisWorkbook or Sheet Code panes given the usage of Public variables. It is worth noting that the ThisWorkbook and Sheet code sections should be reserved for Event coding only, "normal" VBA should be run from Code Modules.

Understanding the code

I will now summarise the main code sections to explain their purpose. The actual code is listed at the end of this Article.

1) Enumerating the MP3 File attributes
Microsoft changed the numbering system for MP3 attributes for Windows Vista. I have used the useful attribute list from , to enumerate the MP3 attributes for the code.

2) Main Sub

The Main subroutine
- initialises the Excel environment,
- resets the public variables,
- creates a new workbook with a single sheet for the output,
- used wscript to determine the Windows Operating System and the path to the My Documents Folder,
- calls the ListMP3Files subroutine,
- dumps the variant array output that has been produced by the ShowSubFolder subroutine,
- formats and applies a filter to the output,
- resets  the Excel environment.

3) ListMP3Files Sub

This sub uses the File Scripting Object to set the initial Folder for the recursive ShowSubFolders sub to start working on.  The ShowSubFolders is called twice, the first time with a True argument to force the ShowSubFolders routine to search for MP3 files within the "My Music" folder, the second time to start a recursive routine on the MP3 files within all the subfolders that reside underneath the "My Music" folder.

4) ShowSubFolders Sub

This subroutine is the code block that used the Shell object in combination with a Dir file filter to retrieve the MP3 file attributes for storage into an variant array.  When the Boolean check (bRootFolder) is set to False the code portion re-calls itself recursively until all the sub-folders underneath My Music have been processed.

The Shell object has two purposes:
a) to provide the sub-folder collection for the retrieval process
b) to retrieve the MP3 attributes using ParseName & GetDetailsOf (please note that the other non-MP3 specific file attributes can be retrieved with the same approach).

One key warning is that the variable containing the file name to be examined using ParseName must be either a hard-coded string, or a variant. Using a string variable will cause the code to "miss" any file being examined.

While it is possible to iterate through all files in the subfolders with the Shell object this would require testing each file to determine whether it is a MP3 file. The Dir approach offers a quick and easy filter instead.

At the end of this code block there is a check as to whether the code has just processes any file within the My Music folder, if True the code exits back to the ListMP3Files subroutine, if False the code continues to process any remaining sub-folder.

If you liked this article and want to see more from this author, [url="http://www.experts-exchange.com/ARTH_770818.html] please click here

If you found this article helpful, please click the Yes button near the:

      Was this article helpful?

label that is just below and to the right of this text.   Thanks!
Option Explicit

Public StrArray()
Public lngCnt As Long
Public b_OS_XP As Boolean

Public Enum MP3Tags
    '  See http://www.kixtart.org/forums/ubbthreads.php?ubb=showflat&Number=160880&page=1 for OS specific attribute lists
    XP_Artist = 16
    XP_AlbumTitle = 17
    XP_SongTitle = 10
    XP_TrackNumber = 19
    XP_RecordingYear = 18
    XP_Genre = 20
    XP_Duration = 21
    XP_BitRate = 22
    Vista_W7_Artist = 13
    Vista_W7_AlbumTitle = 14
    Vista_W7_SongTitle = 21
    Vista_W7_TrackNumber = 26
    Vista_W7_RecordingYear = 15
    Vista_W7_Genre = 16
    Vista_W7_Duration = 17
    Vista_W7_BitRate = 28
End Enum

Public Sub Main()
    Dim objws
    Dim objWMIService
    Dim colOperatingSystems
    Dim objOperatingSystem
    Dim objFSO
    Dim objFolder
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim strobjFolderPath As String
    Dim strOS As String
    Dim strMyDoc As String
    Dim strComputer As String

    'Setup Application for the user
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    'reset public variables
    lngCnt = 0
    ReDim StrArray(1 To 10, 1 To 1000)

    ' Use wscript to automatically locate the My Documents directory
    Set objws = CreateObject("wscript.shell")
    strMyDoc = objws.SpecialFolders("MyDocuments")

    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    For Each objOperatingSystem In colOperatingSystems
        strOS = objOperatingSystem.Caption

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    If InStr(strOS, "XP") Then
        b_OS_XP = True
         strMyDoc = strMyDoc & "\My Music"
        b_OS_XP = False
        strMyDoc = Replace(strMyDoc, "Documents", "Music")
    End If

    ' Format output sheet
    Set Wb = Workbooks.Add(1)
    Set ws = Wb.Worksheets(1)
    ws.[a1] = Now()
    ws.[a2] = strOS
    ws.[a3] = strMyDoc
    ws.[a1:a3].HorizontalAlignment = xlLeft

    ws.[A4:J4].Value = Array("Folder", "File", "Artist", "Album Title", "Song Title", "Track Number", "Recording Year", "Genre", "Duration", "Bit Rate")
    ws.Range([a1], [j4]).Font.Bold = True
    ActiveWindow.FreezePanes = True

    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strMyDoc)

    ' Start the code to gather the files
    ShowSubFolders objFolder, True
    ShowSubFolders objFolder, False

    If lngCnt > 0 Then
        ' Finalise output
        With ws.Range(ws.[a5], ws.Cells(5 + lngCnt - 1, 10))
            .Value2 = Application.Transpose(StrArray)
            .Offset(-1, 0).Resize(Rows.Count - 3, 10).AutoFilter
            .Offset(-4, 0).Resize(Rows.Count, 10).Columns.AutoFit
        End With
        MsgBox "No files found!", vbCritical
        Wb.Close False
    End If

    ' tidy up

    Set objFSO = Nothing
    Set objws = Nothing

    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
        .StatusBar = vbNullString
    End With
End Sub


Sub ShowSubFolders(ByVal objFolder, bRootFolder As Boolean)
    Dim objShell
    Dim objShellFolder
    Dim objShellFolderItem
    Dim colFolders
    Dim objSubfolder

    'strName must be a variant, as ParseName does not work with a string argument
    Dim strFname
    Set objShell = CreateObject("Shell.Application")
    Set colFolders = objFolder.SubFolders
    Application.StatusBar = "Processing " & objFolder.Path

    If bRootFolder Then
        Set objSubfolder = objFolder
        GoTo OneTimeRoot
    End If

    For Each objSubfolder In colFolders
        'check to see if root directory files are to be processed
        strFname = Dir(objSubfolder.Path & "\*.mp3")
        Set objShellFolder = objShell.Namespace(objSubfolder.Path)
        Do While Len(strFname) > 0
            lngCnt = lngCnt + 1
            If lngCnt Mod 1000 = 0 Then ReDim Preserve StrArray(1 To 10, 1 To (lngCnt + 1000))
            Set objShellFolderItem = objShellFolder.ParseName(strFname)
            StrArray(1, lngCnt) = objSubfolder
            StrArray(2, lngCnt) = strFname
            If b_OS_XP Then
                StrArray(3, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Artist)
                StrArray(4, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_AlbumTitle)
                StrArray(5, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_SongTitle)
                StrArray(6, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_TrackNumber)
                StrArray(7, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_RecordingYear)
                StrArray(8, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Genre)
                StrArray(9, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_Duration)
                StrArray(10, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.XP_BitRate)
                StrArray(3, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Artist)
                StrArray(4, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_AlbumTitle)
                StrArray(5, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_SongTitle)
                StrArray(6, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_TrackNumber)
                StrArray(7, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_RecordingYear)
                StrArray(8, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Genre)
                StrArray(9, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_Duration)
                StrArray(10, lngCnt) = objShellFolder.GetDetailsOf(objShellFolderItem, MP3Tags.Vista_W7_BitRate)
            End If
            strFname = Dir
        If bRootFolder Then
            bRootFolder = False
            Exit Sub
        End If
        ShowSubFolders objSubfolder, False
End Sub

Open in new window


Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Join & Write a Comment

Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…
How can you see what you are working on when you want to see it while you to save a copy? Add a "Save As" icon to the Quick Access Toolbar, or QAT. That way, when you save a copy of a query, form, report, or other object you are modifying, you…

Keep in touch with Experts Exchange

Tech news and trends delivered to your inbox every month