I have folders showing up as the following

CodePudding user response：

please take a look at this solution:

Sub RenameFolders()
    
    Dim lastRow As Integer
    lastRow = WorksheetFunction.CountA(Range("A:A"))
    
    Dim newFolderName As String
    Dim oldFolderName As String
    
    Dim newFolderRange As Range
    
    For Each newFolderRange In Range("A1:A" & lastRow)
        oldFolderName = newFolderRange.Offset(0, 1).Value
        newFolderName = GetParentPath(oldFolderName) & newFolderRange.Value
        Name oldFolderName As newFolderName
    Next newFolderRange

End Sub

Function GetParentPath(ByVal path As String)
    
    path = StrReverse(path)
    GetParentPath = StrReverse(Mid(path, InStr(1, path, "\")))

End Function

CodePudding user response：

Using

This leaves us with a much simpler renaming task that can be handled with a single line line of VBA. Specifically, if you drop the path to the directory (including the terminal \) into cell C1 then you can use the immediate window command

For Row=1 To [CountA(A:A)]:Name [C1]&Row As [C1]&Cells(Row,1):Next

to rename the files to your existing list. You can access the immediate window with Alt F11 then Ctrl G. The end result should look something like the below:

Note that I am using the command

For Each fld in CreateObject("Scripting.FileSystemObject").GetFolder([C1]).SubFolders: ?fld.Name: Next

to verify the change in the image above