VBA Rename Folder

[12Rev79]

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;

    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?

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

Thanks in advance,
12Rev79

 

[Zot]

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.

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

 

[12Rev79]

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.

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.

 

[Zot]

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]

The same error I got here after revising the code.

can you please help.

Thanks again.

 

[Zot]

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

 

[12Rev79]

Thank you Zot