VBA Rename Folder

12Rev79

New Member
Joined
Mar 2, 2021
Messages
30
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
Hi Experts,

I have the code below that would list Folder Names in my Excel and this is the Step 1 that I want, it's working will;
VBA Code:
    Dim objFSO As Object
    Dim objFolders As Object
    Dim objFolder As Object
    Dim strDirectory As String
    Dim arrFolders() As String
    Dim FolderCount As Long
    Dim FolderIndex As Long
   
Range("B5").Offset(1, 0).Select
Range(Selection, Selection.End(xlDown)).ClearContents

    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = Application.DefaultFilePath & "\"
        .Title = "Select Folder : Denver"
        .Show
        If .SelectedItems.Count = 0 Then
            Exit Sub
        End If
        strDirectory = .SelectedItems(1)
    End With
   
    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("Rename_ver2").Range("B6").Resize(FolderCount).Value = Application.Transpose(arrFolders)
    Else
        MsgBox "No folders found in the Selected directory!", vbExclamation
    End If
   
    Set objFSO = Nothing
    Set objFolders = Nothing
    Set objFolder = Nothing

Step 2 I need a code to rename the folder name base on what I have assigned in corresponding Column C rows? I've tried to find any related threads but I was not lucky to find one.
AdditionalNo action needed if one of the rows in Column C is blank?
1617600846999.png

Please anyone is kind to help me figure out the code would be?

Thanks in advance,
12Rev79
 
Last edited by a moderator:

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,171
Office Version
  1. 2016
Platform
  1. Windows
I'm assuming that you have the List Main Foldername in Sheet1 in Column A and the New Foldername in column C.

The code will let you select location where all the folders you wanted to rename resides. Then it will loop through all the list in column A, skipping the row with empty column C and renamed the folders in the list.
VBA Code:
Sub RenameFolder()

Dim SelectFolder As Integer
Dim PathName As String
Dim OldName As String, NewName As String
Dim cell As Range
Dim wsList As Worksheet

' Select main folder where all sub-folders to be renamed located
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
    PathName = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Set wsList = ActiveWorkbook.Sheets(1)

For Each cell In wsList.Range("A2", wsList.Cells(Rows.Count, "A").End(xlUp))
    If Not Len(wsList.Range("C" & cell.Row)) = 0 Then
        OldName = PathName & "\" & cell & "\"
        NewName = PathName & "\" & cell.Offset(0, 2) & "\"
        Name OldName As NewName
    End If
Next

End Sub
 
Solution

12Rev79

New Member
Joined
Mar 2, 2021
Messages
30
Office Version
  1. 365
  2. 2010
Platform
  1. Windows
I'm assuming that you have the List Main Foldername in Sheet1 in Column A and the New Foldername in column C.

The code will let you select location where all the folders you wanted to rename resides. Then it will loop through all the list in column A, skipping the row with empty column C and renamed the folders in the list.
VBA Code:
Sub RenameFolder()

Dim SelectFolder As Integer
Dim PathName As String
Dim OldName As String, NewName As String
Dim cell As Range
Dim wsList As Worksheet

' Select main folder where all sub-folders to be renamed located
SelectFolder = Application.FileDialog(msoFileDialogFolderPicker).Show
If Not SelectFolder = 0 Then
    PathName = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1)
Else
    End
End If

Set wsList = ActiveWorkbook.Sheets(1)

For Each cell In wsList.Range("A2", wsList.Cells(Rows.Count, "A").End(xlUp))
    If Not Len(wsList.Range("C" & cell.Row)) = 0 Then
        OldName = PathName & "\" & cell & "\"
        NewName = PathName & "\" & cell.Offset(0, 2) & "\"
        Name OldName As NewName
    End If
Next

End Sub
Dear Zot, thank you so much for the help but I have the following error.

and I modify a few from the codes to align the rows that as per snapshot.

What is wrong here please help.

1618027757478.png



1618027885766.png
 

Attachments

  • 1618027863120.png
    1618027863120.png
    11.7 KB · Views: 3

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,171
Office Version
  1. 2016
Platform
  1. Windows
I think it is because the folder name could not be found.

I don't know why you have Offset(5,2) in you code. Your old folder name starts from B6. The code was checking if C6 is emty or not, If empty, it should skip rename. Therefore, the Offset (0,1) should be used (meaning same row but next 1 column which is C)
 

12Rev79

New Member
Joined
Mar 2, 2021
Messages
30
Office Version
  1. 365
  2. 2010
Platform
  1. Windows

ADVERTISEMENT

The same error I got here after revising the code.

can you please help.

Thanks again.

1618204436251.png


1618204578716.png
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
1,171
Office Version
  1. 2016
Platform
  1. Windows
When the code run, you will select the folder where all the folders you wanted to rename reside. Then it will rename all the folders in that parent folder.

I created several dummy folder on Desktop and run the program to select the Desktop. The program has no error. This program run independently after you have the List Main Foldername. It seems to me that the error you got is No File Found. I was able to simulate this when I did not click the folder. You must click the folder and in the Dialog Box shows Folder Name : <foldername> has folder name showed up, not blank
 

Watch MrExcel Video

Forum statistics

Threads
1,130,033
Messages
5,639,661
Members
417,104
Latest member
Nelsini

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top