【VBA】指定フォルダ配下（サブフォルダ含む）にある全てのExcelファイルに対し置換処理を行う

サンプルプログラム概要

①拡張子が「xlsx」のファイルのみを対象

②シートが保護されている

③シートの保護のパスワードは「password」

④置換条件は以下
　┗大文字と小文字を区別する
　┗セル内容が完全に同一であるものを検索する
　┗半角と全角を区別する

前提

シート上に以下を指定する。

セル「B3」：入力フォルダを指定
セル「B5」：置換前の文字列を指定
セル「B6」：置換後の文字列を指定

サンプルプログラム

'●MainModule
Option Explicit

Sub execButton_click()
    
    Dim ws As Worksheet
    Dim inputFolder As String
    Dim replaceBefore As String
    Dim replaceAfter As String
    
    '初期化処理
    Call init(False)
    
    '入力フォルダ、置換前/置換後の文字列を取得
    Set ws = ActiveSheet
    inputFolder = ws.range("B3").Value
    replaceBefore = ws.range("C5").Value
    replaceAfter = ws.range("C6").Value
    
    '置換処理
    Call replaceFile(inputFolder, replaceBefore, replaceAfter)
    
    '後片付け
    Set ws = Nothing
    
    '初期化処理
    Call init(True)
    
End Sub

'初期化処理
'画面描画/イベント/確認メッセージ/自動計算の抑止、抑止解除
Private Function init(status As Boolean)
    
    With Application
        .ScreenUpdating = status
        .EnableEvents = status
        .DisplayAlerts = status
        
        If status Then
            .Calculation = xlCalculationAutomatic
        Else
            .Calculation = xlCalculationManual
        End If
    End With

End Function

'●replaceFileModule
Option Explicit

'置換処理
Public Function replaceFile(inputFolder As String, _
                                replaceBefore As String, _
                                replaceAfter As String)

    Dim fso As Object
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    '置換処理
    Call execReplaceFile(inputFolder, replaceBefore, replaceAfter, fso)
    
    Set fso = Nothing

End Function

'置換処理
Private Function execReplaceFile(inputFolder As String, _
                                replaceBefore As String, _
                                replaceAfter As String, _
                                fso As Object)
    
    Const INPUT_SHEET_NAME As String = "sheet1"
    Const TARGET_FILE_TYPE As String = "xlsx"
    
    Dim file As Object
    Dim folders As Object
    Dim ws As Worksheet
    Dim wk As Workbook
    
    'サブフォルダ取得
    For Each folders In fso.getFolder(inputFolder).SubFolders
        Call execReplaceFile(folders.Path, replaceBefore, replaceAfter, fso)
    Next
    
    Set ws = ActiveSheet
       
    'ファイル数分繰り返し
    For Each file In fso.getFolder(inputFolder).files
        If LCase(fso.GetExtensionName(file.Name)) = TARGET_FILE_TYPE Then
            
            'Excelファイルを開く　※「リンクの更新」はしないで開く
            Set wk = Workbooks.Open(Filename:=file.Path, UpdateLinks:=0)
        
            'シートの保護を解除
            wk.Sheets(INPUT_SHEET_NAME).Unprotect Password:="password"

            '各ファイルに対して置換処理を行う
            wk.Sheets(INPUT_SHEET_NAME).Cells.Replace _
                                        What:=replaceBefore, _
                                        Replacement:=replaceAfter, _
                                        LookAt:=xlWhole, _
                                        SearchOrder:=xlByRows, _
                                        MatchCase:=True, _
                                        SearchFormat:=False, _
                                        ReplaceFormat:=False

            'シートの保護を再設定する
            wk.Sheets(INPUT_SHEET_NAME).Protect Password:="password"
                                        
            'Excelファイルを保存して閉じる
            wk.Close SaveChanges:=True
            
        End If
    Next
    
    '後片付け
    Set ws = Nothing
    Set wk = Nothing
    
End Function