This can be done as follows:
- Choose the primary folder
- Loop in folders and subfolders for listing these
- Write the folders and subfolders found on a temporary worksheet called "temp" by removing "[" or "]"
- Rename with a loop back with
Step -1 (because there are errors if you start renaming through folders, not subfolders)
Example Code
Sub Renomear_Pastas()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim xDir As String
Dim folder As Object
Dim i As Long, linha As Long
'Adiciona Planilha Temporária
Dim temp As Worksheet
SheetKiller ("temp")
ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(Sheets.Count)).Name = "temp"
Set temp = ThisWorkbook.Sheets("temp")
'Escolher o Diretório
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
With folder
.Title = "Escolha a pasta"
End With
If folder.Show <> -1 Then GoTo CleanExit
On Error Resume Next
xDir = folder.SelectedItems(1) & "\"
'Função para retirar Parêneteses Reto ou Colchetes
retirar_pr xDir
'Renomear
linha = temp.Range("A" & temp.Rows.Count).End(xlUp).Row
For i = linha To 2 Step -1
Name temp.Cells(i, "A") As temp.Cells(i, "B")
Next i
'Sair do código
CleanExit:
Set fso = Nothing
Set fso_FOLDER = Nothing
SheetKiller ("temp")
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Sub retirar_pr(ByVal xFolderName As String)
Dim xFileSystemObject As Object
Dim xFolder As Object
Dim xSubFolder As Object
Dim xFile As Object
Set xFileSystemObject = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFileSystemObject.GetFolder(xFolderName)
Dim nome_pasta As String, caminho As String, nova_pasta As String
Dim linha As Long
Dim temp As Worksheet
Set temp = ThisWorkbook.Sheets("temp")
'Loop em cada Subpasta
For Each xSubFolder In xFolder.SubFolders
'Procurar pela pasta e retirar [ ou ]
nome_pasta = Right(xSubFolder, Len(xSubFolder) - InStrRev(xSubFolder, "\"))
'Caso possua [ ou ]
If InStr(nome_pasta, "[") Or InStr(nome_pasta, "]") Then
linha = temp.Range("A" & temp.Rows.Count).End(xlUp).Row + 1
nome_pasta = Replace(nome_pasta, "[", "")
nome_pasta = Replace(nome_pasta, "]", "")
caminho = Left(xSubFolder, InStrRev(xSubFolder, "\"))
nova_pasta = caminho & nome_pasta
'Escreve na planilha temporária os nomes antigos e novo da nova pasta
temp.Cells(linha, "A") = xSubFolder
temp.Cells(linha, "B") = nova_pasta
retirar_pr xSubFolder.Path
End If
Next xSubFolder
Set xFile = Nothing
Set xFolder = Nothing
Set xFileSystemObject = Nothing
End Sub
Public Function SheetKiller(Name As String)
'Remove Planilha
Dim s As Worksheet, t As String
Dim i As Long, k As Long
k = ThisWorkbook.Sheets.Count
For i = k To 1 Step -1
t = ThisWorkbook.Sheets(i).Name
If t = Name Then
Application.DisplayAlerts = False
ThisWorkbook.Sheets(i).Delete
Application.DisplayAlerts = True
End If
Next i
End Function
