Community Pick: Many members of our community have endorsed this article.

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



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="] 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 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("")
                          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


Comments (0)

Have a question about something in this article? You can receive help directly from the article author. Sign up for a free trial to get started.