OK, based on the detail you have confirmed, this should do what you want assuming you actually want the files on your H: drive renamed?
This is assuming in column D, you have a list of all the original filenames. In column E you have the new filename you want. I didn't check if the new filename has the file extension? Based on your earlier reply, I'm assuming it doesn't and have coded accordingly, but it should work with or without the file extension in column E, i.e. it can either be songtitle or songtitle.mp3
Sub SongRenameV2()
Dim c As Object
Dim i As Integer
Dim intPeriodPos As Integer
Dim strOldSongPath As String
Dim strNewSongPath As String
Dim strNewSongName 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("D3")
'Begin loop
Do Until IsEmpty(c)
'Get the full file path and the new song name
strOldSongPath = c.Value
strNewSongName = c.Offset(0, 1).Value
'Search for the file extension delimiter
intPeriodPos = InStr(1, strNewSongName, ".", vbTextCompare)
'Only re-add the file extension if missing
If intPeriodPos = 0 Then
strNewSongName = strNewSongName & Right(strOldSongPath, Len(strOldSongPath) - intPeriodPos + 1)
End If
'Split the full path of the song into an array
varSongData = Split(strOldSongPath, "", , vbTextCompare) 'There should be a \ in between the quotes
'Recreate the path
For i = LBound(varSongData) To UBound(varSongData) - 1 Step 1
strNewSongPath = strNewSongPath & varSongData(i)
strNewSongPath = strNewSongPath & "" 'There should be a \ in between the quotes
Next i
'Append the name back
strNewSongPath = strNewSongPath & strNewSongName
'As long as the file exists, rename it
If fso.FileExists(strOldSongPath) Then
fso.MoveFile strOldSongPath, strNewSongPath
End If
'Move object reference
Set c = c.Offset(1, 0)
Loop
'Remove object reference
Set fso = Nothing
End Sub
