How to delete straight parentheses from some subfolders I have using an excel macro?

Question

I have a folder called "Franchisees" where there are several subfolders with the names of franchisees. Inside each franchisee’s folder there are some subfolders whose names contain straight parentheses.

I want to program a macro to delete the straight parentheses of these subfolders without changing the rest of their names.

Ex:

Current Name C:\Users\jcoutinho006\Desktop\Franquiados\Fernando Soares\[04] Catálogo de Tratamento de Dados Pessoais_

Name after using macro C:\Users\jcoutinho006\Desktop\Franquiados\Fernando Soares\04 Catálogo de Tratamento de Dados Pessoais_

Does anyone know what code to use?

Answer 1

This can be accomplished as follows:

• Choice of the main folder
• Loop in folders and subfolders for listing these
• Write the folders and subfolders found in a temporary worksheet called "temp", removing "[" or "]"
• Rename with a back loop with Step -1 (because there are errors if start renaming by folders and not subfolders)

Sample 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