I cleaned up my mp3 collection - remove track numbers etc. Now I need to rename them

[keithmct]

Hi all, through some YouTube vids I have succeeded in listing all my mp3's from the music directory H:\Music. The full path shows in column F. Existing track name excluding file type extension is in column A. eg. 01 - Beethoven 9th symphony. New desired file name is in column B eg Beethoven 9th symphony, without file extension.
Subfolders of H:\Music are the usually artist name and sub-sub folders are the albums with the mp3 files. Sometime mp3's don't have an album and are just in the artist folder. Regardless, in column F, I need a way to substitute whatever is between the last backslash and .mp3 with the data in column B.
Thanks in advance

 

[MartinS]

Can you provide a couple of examples of what you have, it's not clear from reading your request what is where. It would be helpful to provide some examples where the album is missing as well.
Thanks
Martin

 

[keithmct]

sometimes the path is H:\Music\songtitle.mp3
sometimes H:\Music\Artist\songtitle.mp3
sometimes H:\Music\Artist\Album\songtitle.mp3

I have a utility which splits the pathname by backslash, which goes into separate new columns but of course as some songs dont have an artist and some have an artist but no album name, they dont always line up correctly. If i could extract from the path anything after the last backslash (songtitle.mp3) to a new column, then maybe that would be a start. But then once I replace that with the desired new name, how does excel tell windows to rename the files?

 

[MartinS]

Thanks.
So you could do something like this:
Function GetSong(strSongPath as String)
Dim varSongData as Variant
Dim strSongName as String
Dim intPeriodPos as Integer
varSongData = Split(strSongPath, "", , vbTextCompare) 'There should be a \ in between the quotes
strSongName = UBound(varSongData)
intPeriodPos = InStr(1, strSongName, ".", vbTextCompare)
If intPeriodPos > 0 Then
strSongName = Left(strSongName, intPeriodPos - 1)
End If
GetSong = strSongName
End Function

So, in a blank column, type =GETSONG(F1) (where F1 contains one of the text examples above) and you should get just the song name back without the extenstion. I also manages the song not having an extension.

Hope this helps

Martin

 

[MartinS]

If this is what you are looking for, then we can move on to actually renaming the files, but confirm if this is your desired result first and we can go from there.

 

[keithmct]

it returns a number (2,3,4) which I'm guessing is the position of the song depending on how many backslashes there are.

 

[MartinS]

Yes, sorry - was working on a rename solution and realised my error!
This line strSongName = UBound(varSongData) should be strSongName = varSongData(UBound(varSongData))

 

[keithmct]

that worked

 

[MartinS]

OK, so try this. I define a column of your examples, which started in A5, so just adjust the start point as necessary. The loop will stop when it finds an empty cell.

Sub SongRename()

Dim c As Object
Dim i As Integer
Dim strSongPath As String
Dim strSongName As String
Dim varSongData As Variant
Dim fso As Object
'Create reference to scripting runtime
Set fso = CreateObject("Scripting.FileSystemObject")
'Define the range to start looking in
Set c = Sheets("Sheet1").Range("A5")
'Begin loop
Do Until IsEmpty(c)
'Get the full file path
strSongPath = c.Value
'Split the full path of the song into an array
varSongData = Split(strSongPath, "", , vbTextCompare) 'There should be a \ in between the quotes
'Get the new name without the extension
strSongName = GetSong(strSongPath)
'clear variable before recreating it
strSongPath = vbNullString
'Recreate the path
For i = LBound(varSongData) To UBound(varSongData) - 1 Step 1
strSongPath = strSongPath & varSongData(i)
strSongPath = strSongPath & "" 'There should be a \ in between the quotes
Next i
'Append the name back
strSongPath = strSongPath & strSongName
'As long as the file exists, rename it
If fso.FileExists(strSongPath) Then
fso.MoveFile c.Value, strSongPath
End If
'Move object reference
Set c = c.Offset(1, 0)
Loop
'Remove object reference
Set fso = Nothing
End Sub

Function GetSong(strSongPath As String)

Dim varSongData As Variant
Dim strSongName As String
Dim intPeriodPos As Integer

'Split the full path of the song into an array
varSongData = Split(strSongPath, "", , vbTextCompare) 'There should be a \ in between the quotes
'Get the last array item, wchich should always be the song title
strSongName = varSongData(UBound(varSongData))
'Search for the file extension delimiter
intPeriodPos = InStr(1, strSongName, ".", vbTextCompare)
'Only remove the file extension where present
If intPeriodPos > 0 Then
strSongName = Left(strSongName, intPeriodPos - 1)
End If

GetSong = strSongName

End Function

 

[keithmct]

I thought I had replied, but apparently not.
I dont understand how to apply this code. Is the GetSong function still required? It looks to be incorporated into the Sub SongRename() part.
I copied my data to a new experimental sheet called rename
Copied this code into a module and ran it and it didn't do anything. I put the backslashes in and adjusted the starting cell which is now Set c = Sheets("rename").Range("D3")
D3 has the complete path to the song file.