VBA Tips - Substituindo caracteres nos nomes de arquivos num diretório - Replace Characters in the Filenames of a Directory


A funcionalidade que observaremos no código abaixo substituirá os caracteres (strings) em todos os nomes de arquivos presentes no diretório fornecido.

Útil em inúmeras situações, quais?

- Quando desejar criar relatórios dentro de pastas.

- Quando precisar gravar dados em pastas criadas anteriormente e precise ajustar o nome do período.

- Quando desejar gravar relatórios dentro de pastas com os respectivos nomes dos agrupamentos.

- Etc...

Use o código abaixo e se divirta:

Function Repl_Char_FName (ByVal Path As String, ByVal OldChr As String, ByVal NewChr As String)
    Dim FileName As String

    'Input Validation
    'Trailing backslash (\) is a must

    If Right(Path, 1) <> "\" Then Path = Path & "\"
    
    'Directory must exist and should not be empty.
    If Len(Dir(Path)) = 0 Then
        Let Repl_Char_FName  = "No files found."
        Exit Function

    'Old character and New character must not be empty or null strings.
    ElseIf Trim(OldChr) = "" And OldChr <> " " Then
        Let Repl_Char_FName  = "Invalid Old Character."
        Exit Function
    ElseIf Trim(NewChr) = "" And NewChr <> " " Then
        Let Repl_Char_FName  = "Invalid New Character."
        Exit Function
    End If
    
    Let FileName = Dir(Path & "*.*") 'Use *.xl* para Excel e *.doc para arquivos Word

    Do While FileName <> ""    
        Name Path & FileName As Path & Replace (FileName, OldChr, NewChr)

        Let FileName = Dir
    Loop

    Let Repl_Char_FName = "Ok"
End Function

Teste as funcionalidades:

Sub Samp_Use()
    Dim lResult As String
    
    lResult = Replace_Filename_Character("C:\Bernardes\Test", " ", "_")
    Debug.Print lResult 'Returns Ok
    
    lResult = Replace_Filename_Character("C:\Bernardes\Test", " ", "_")
    Debug.Print lResult 'Returns Ok though no spaces in filenames now
    
    lResult = Replace_Filename_Character("C:\Bernardes\Test\", "", "_")
    Debug.Print lResult 'Returns 'Invalid Old Character'
    
    lResult = Replace_Filename_Character("C:\Bernardes\Test01", " ", "_")
    Debug.Print lResult 'Returns 'No files found' as invalid directory provided.
End Sub


Tags: VBA, tips, string, substituir, replace






Nenhum comentário:

Postar um comentário

diHITT - Notícias