How can I create a list from a single layer of a directory?

[JOSHSKORN]

I'm creating a spreadsheet to lookup which album a song is on. The gist of it is this:

Artist Name: (Choose from list - Cell B3, A3 will be the Artist Name label)

Song Title: Cells A6 through the last song in the list
Album: Cells B6 through the last value entered from the song title column.

I plan on going to a website like setlists.fm, copying and pasting setlists into Notepad or another Excel Spreadsheet, cleaning up the data, then inputting only the songs into this spreadsheet to find which album they're on.

I have all of my music in my music directory on my computer, in WAV format.

The first step, when the spreadsheet loads, I want it to populate artists names. It needs to get this information from my Music folder. The directory structure is like this:

D:\Music\ArtistName\AlbumName\(songs in WAV format plus some pictures)

So, I'll create a variable, call it musicRoot and set it equal to "D:\Music", for starters.

How can I load a list of folders, just one layer in from the musicRoot? I want the cell (B4) to essentially be a combo box with artists names.

I think what I might end up doing also is, upon the change of contents for B4, create a variable called "songRoot" so when I input a track name, it'll only search that artist's particular subdirectories. I Imagine this code would be similar for what's needed for B3.

See attached. Yes, I realize some song titles might not lookup correctly due to special characters involved. I might look into trying to use a tag, instead of a file name.

 

[PeteWright]

@JOSHSKORN

Before I start coding a VBA Macro that fits your needs, let me introduce you another method: utilizing the music player foobar2000.
Everything you mentioned could be done much easier with foobar and you can play with the file tags of course.

Below are some screenshots of the whole procedure (including settings dialogs) of finding the right album:


Quick Search Preferences

Right-Click (Context Menu) > Quicksearch for same > Artist Album

Result in a new Playlist

Text Tools Preferences

Right-Click (Context Menu) > Utilities > Text Tools > Copy: Artist - Title - Album

Paste into a text editor etc.

- OR -

automatically save (append at the end) to a text file

Preferences

resulting text file

Customize buttons

And of course you could assign keys to those tasks and make it even faster by hitting the right keys on your keyboard.

This is only a very simple example of what can be done with foobar.
It is highly customizable and offers a lot of built-in features and also downloadable components.

If you are interested in this method, please let me know.

Otherwise, if you prefer the Excel/VBA version, please explain the desired output (worksheet) in detail, I'm not quite sure how it should look like.

Kind regards
Pete

 

[JOSHSKORN]

@PeteWright, I actually do use Foobar2000 for tagging. For whatever reason, I always used the Artist tag and not the Album Artist tag for the artist. It's a pain when artists do collaborations because once I use Discogs to tag them, if I tag the artist field, it screws everything up and I can't find it. A prime example of that is Korn, on one of their albums, they do a lot of collabs, so when I tag them, I have to change the artist tag based on how I have my foobar2000 form set up. I guess I never really fully understood the two tags correctly, or at least as intended. So if I had a track like Korn and Skrillex, I'd change the artist tag to just Korn.

Now, if I can somehow accomplish what I want via foobar2000, that would be fine. On my current form, it's a bit of a mess and I haven't actually modified it in quite some time.

Again, the goal is this:

1. On the Spreadsheet, specify the name of the band you're looking up from a list. Essentially, the entire list would be every artist listed on my Foobar2000 what's on my computer.
2. Go to setlists.fm, copy the setlist of a specific band and the setlist from a show.
3. Paste into a blank Excel Spreadsheet. Sort, then Get rid of any irrelevant data manually
4. Copy the new list and paste into my Excel Spreadsheet. The next column over should populate with an album name.

If you take a look at the image I uploaded, I did omit the album names, but realistically, they should be listed the moment a song track is listed, I think that's why I left it blank.

I think I might go over to the Foobar2000 forums to see if something like this already exists or if an existing mod can be modified in such a way.

 

[PeteWright]

@JOSHSKORN
You could adjust foobar in a way that your %artist% field won't be messed up by setting the mappings of your discogs tags. In addition you can use a pattern that searches the %filename% field and/or the %album_artist% (or however the variable is called).

Then you could make use of the CSV file format which is both human-readable and Excel-friendly.

There are many options.

If you were satisfied with the foobar method I could figure something out.

It is also possible to make a mixed method work with Excel/VBA/foobar 2000.

It depends on what your final goal is.

Do you want to end up with an Excel file that contains all your matched tracks?
Or a tracklist which could also be text or CSV?

I'm still not sure what you want as a result of your query.

Once I know that and you decide what method you choose I can figure something out.

So please let me know.

 

[JOSHSKORN]

@PeteWright,

I'm actually fooling around a bit more with Excel on this. What I've managed to do, is create a list of folders under the directory D:\Music. This is one step. The next, is to add this list into a cell. The method I found, is Data Validation. So, I created a Macro, did some more Googling and modified it in such a way such that one of my cells now populates with every folder located directly under D:\Music (so not subfolders).

I did put these code snippets in their own module files and changed them from Dim to Public. The array that was used, I made that Public as well.

Option Explicit

Public arrFolders() As String


Public Sub ListFoldersInDirectory()

    Dim objFSO As Object
    Dim objFolders As Object
    Dim objFolder As Object
    Dim strDirectory As String
    Dim FolderCount As Long
    Dim FolderIndex As Long

    strDirectory = "D:\Music"

    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Set objFolders = objFSO.GetFolder(strDirectory).SubFolders

    FolderCount = objFolders.Count

    If FolderCount > 0 Then
        ReDim arrFolders(1 To FolderCount)
        FolderIndex = 0
        For Each objFolder In objFolders
            FolderIndex = FolderIndex + 1
            arrFolders(FolderIndex) = objFolder.Name
        Next objFolder
        'Worksheets.Add
        'Range("E1").Resize(FolderCount).Value = Application.Transpose(arrFolders)
    Else
        MsgBox "No folders found!", vbExclamation
    End If

    Set objFSO = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing

    GetDVList
End Sub




Public Sub GetDVList()

    Range("B3").Select

    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(arrFolders, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True

    End With

End Sub

For the most part, might be able to figure the rest of this out, but I do have one question.

How would I be able to search for a file and return its immediate directory?

Lets say I'm searching for the string "I Stand Alone", a track by Godsmack off of the album Faceless. The file is sitting in the directory "D:\Music\Godsmack\Faceless".

How can I return only the value Faceless? This particular directory contains a file called I Stand Alone.wav. For now, I'd be searching just the file name, not the tag on the file.

The attached screenshot not the best example, I want to be able to do this for all items copied in the list., so looking up all items automatically. I've only listed 1.

 

[JOSHSKORN]

Here's an update.

I'm now dealing with three different sections for coding on my project.

1 Spreadsheet: AlbumLookup
2 Modules

On my Spreadsheet code:

Public MusicRootPath As String
Public artistRootPath As String

Private Sub Worksheet_Activate()
    MusicRootPath = "D:\Music"
    
    ListFoldersInDirectory (MusicRootPath)
    GetDVList
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    ' Album Finder (In VB)
    Dim artistName As String
    artistName = Range("B3").Value
    
    If Target.Address = "$B$3" Then
        artistName = Range("B3").Value
        MsgBox "You changed the artist to: " + artistName
        artistRootPath = MusicRootPath + "\" + artistName
        MsgBox "Artist Full Path: " + artistRootPath
    End If
End Sub

Module #1

Option Explicit
Public arrFolders() As String

Public Sub ListFoldersInDirectory(strDirectory As String)


    Dim objFSO As Object
    Dim objFolders As Object
    Dim objFolder As Object
    'Dim strDirectory As String

    Dim FolderCount As Long
    Dim FolderIndex As Long
      
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolders = objFSO.GetFolder(strDirectory).subfolders
    
    FolderCount = objFolders.Count
    
    If FolderCount > 0 Then
        ReDim arrFolders(1 To FolderCount)
        FolderIndex = 0
        For Each objFolder In objFolders
            FolderIndex = FolderIndex + 1
            arrFolders(FolderIndex) = objFolder.Name
        Next objFolder
        'Worksheets.Add
        'Range("E1").Resize(FolderCount).Value = Application.Transpose(arrFolders)
    Else
        MsgBox "No folders found!", vbExclamation
    End If
    
    Set objFSO = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing
    
    
End Sub

Module #2:

Public Sub GetDVList()
'
' GetDVList Macro
'
'
    Range("B3").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(arrFolders, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

What works:

• All artist folders load correctly into cell B3.
• The artist path is create when selecting an artist from Cell B3.

What doesn't work yet/need help with

• From cells B6 to the end (using xlDown, likely), search for the file names containing the contents of each cell, return their immediate folder in column B, same row. If not found, return "Error" in the corresponding column.

I'd modified one of the sub-procedures, ListFoldersInDirectory to accept input, thinking I might possibly reuse it to load album directories, but I'm not sure where I'm going with that.

 

[PeteWright]

Hi @JOSHSKORN

I rearranged and modified your code and it seems to work.
Though I cannot guarantee that no errors may occur!

Here's my code

Worksheet "AlbumLookup" (Sheet1):

Private Sub Worksheet_Activate()
   If Initiated = False Then Init
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
   If Not Intersect(Target, Range("A:A")) Is Nothing Then
      If Target.Count > 1 Then
         Exit Sub
      Else
         Dim artistName As String: artistName = Range("B3").Value
         Dim Title As String
         If Target.Address = "$B$3" Then
            artistName = Range("B3").Value
            MsgBox "You changed the artist to: " + artistName
            artistRootPath = MusicRootPath + "\" + artistName
            MsgBox "Artist Full Path: " + artistRootPath
         End If
         If Left(Target.Address, 2) = "$A" And Target.Value <> "" Then
            Title = Target.Value
            'Application.EnableEvents = False
            Cells(Target.Row, Target.Column + 1) = GetArtistAlbum(artistName, Title)
            'Application.EnableEvents = True
         End If
      End If
   End If
End Sub

Module "Main":

Option Explicit
Public Initiated As Boolean
Public MusicRootPath As String
Public artistRootPath As String
Public arrFolders() As String

Public Sub Init()
   MusicRootPath = "D:\Music"
   ListFoldersInDirectory (MusicRootPath)
   GetDVList
   Initiated = True
End Sub

Module1:

Option Explicit

Public Sub ListFoldersInDirectory(strDirectory As String)
    Dim objFSO As Object
    Dim objFolders As Object
    Dim objFolder As Object
    Dim FolderCount As Long
    Dim FolderIndex As Long
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolders = objFSO.GetFolder(strDirectory).SubFolders
    
    FolderCount = objFolders.Count
    
    If FolderCount > 0 Then
        ReDim arrFolders(1 To FolderCount)
        FolderIndex = 0
        For Each objFolder In objFolders
            FolderIndex = FolderIndex + 1
            arrFolders(FolderIndex) = objFolder.Name
        Next objFolder
    Else
        MsgBox "No folders found!", vbExclamation
    End If
    
    Set objFSO = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing
End Sub

Public Sub GetDVList()
' GetDVList Macro
    Range("B3").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=Join(arrFolders, ",")
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

Module2:

Option Explicit

Public Function GetArtistAlbum(ByVal Artist As String, ByVal TrackTitle As String) As String
   If Initiated = False Then Init
   artistRootPath = MusicRootPath + "\" + Artist
   Dim fso As Object: Set fso = CreateObject("Scripting.FileSystemObject")
   Dim fol As Object: Set fol = fso.GetFolder(artistRootPath)
   Dim fil As Object
   Dim Albums As Object: Set Albums = fol.SubFolders
   Dim Album As Object
   Dim Tracks As Object
   Dim Track As Object
   
   For Each Album In Albums
      Set Tracks = Album.Files
      For Each Track In Tracks
         If LCase(Left(Track.Name, InStr(Track.Name, ".") - 1)) = LCase(TrackTitle) Then
            GetArtistAlbum = Album.Name
            GoTo DestroyObjects
         End If
      Next Track
   Next Album
   
   GetArtistAlbum = "-"
   
DestroyObjects:
   Set Tracks = Nothing
   Set Albums = Nothing
   Set fil = Nothing
   Set fol = Nothing
   Set fso = Nothing
End Function

Please try it out and tell me if it works and in case of errors please post them here.