Excel VBA - bestandsnamen wijzigen

Met behulp van de onderstaande procedure kunnen tekens in de bestandsnamen bulksgewijs vervangen worden. Deze procedure gaat opzoek naar alle bestanden in alle relatieve submappen ten opzichte van de locatie van deze werkmap.

In het bovenstaande voorbeeld is er gezocht naar het teken "-" en vervangen door het teken "_".

'-----------------------------------------------------------------------------------------------------------------------
' Auteur        : pascalterheege.nl
' Datum         : 23-1-2016
' Object        : modBestand
' Doel          : bestandsnamen vervangen in relatieve submappen t.o.v. de locatie van deze werkmap
' Verwijzing    : Microsoft Scripting Runtime
' Bron          :
'-----------------------------------------------------------------------------------------------------------------------
Option Explicit

Sub vervangBestandsnaam()

'   Variabelen declareren
    Dim fso As New FileSystemObject
    Dim fld As Folder
    Dim sfld As Folder
    Dim f As File
    
    Dim strZoekenNaar As String
    Dim strVervangenDoor As String
    
    Dim strBestandOud As String
    Dim strBestandNieuw As String
    
    Dim r As Integer
    
'   Zoeken en vervangen initialiseren
    strZoekenNaar = InputBox("Zoeken naar?", , "-")
    strVervangenDoor = InputBox("Vervangen door?", , "_")
        
'   Hoofdmap initialiseren
    Set fld = fso.GetFolder(ActiveWorkbook.Path)
        
    r = 2
    
'   Itereren door submappen van hoofdmap
    For Each sfld In fld.SubFolders
    
'       Itereren door bestanden
        For Each f In sfld.Files
                
'           Huidige bestandsnaam
            strBestandOud = f.Name
'           Nieuwe bestandsnaam
            strBestandNieuw = Replace(f.Name, strZoekenNaar, strVervangenDoor)
                   
'           Als de bestandsnamen afwijken dan pas aanpassen!
            If strBestandOud = strBestandNieuw Then
                   
'               Bestand verplaatsen met nieuwe bestandsnaam
                fso.MoveFile sfld.Path & Application.PathSeparator & strBestandOud, _
                sfld.Path & Application.PathSeparator & strBestandNieuw
                
'               Logbestand
                Cells(r, 1).Value = r - 1
                Cells(r, 2).Value = sfld.Name
                Cells(r, 3).Value = strBestandOud
                Cells(r, 4).Value = strBestandNieuw
                
                r = r + 1
            
            End If
        
        Next f
    
    Next sfld
    
End Sub

Download hier het oefenbestand.