【ExcelVBA】フォルダ内のファイルへ順番に書き込み処理をする方法

Sub Sample()

Dim ForlderPath As String
Dim TargetBook As Workbook
Dim TargetFile As Object
Dim fso As Object
Dim MsgStr As String

    'アラートを表示しない
    Application.DisplayAlerts = False

    'シートに書いてあるフォルダパスを変数に設定
    ForlderPath = ActiveSheet.Range("B2")
  
    'フォルダが存在しない場合は終了する
    If Dir(ForlderPath) = "" Then
    
        'アラートメッセージを表示する
        MsgBox "フォルダが存在しません。処理を中止します。"
        
        '処理を抜ける
        Exit Sub
    End If
    
    'FileSystemObjectのインスタンスを作成
    Set fso = CreateObject("Scripting.FileSystemObject")
        
    'フォルダ内のファイルをループ
    For Each TargetFile In fso.GetFolder(ForlderPath).Files
    
        'ファイルの拡張子が「.xlsx」の場合
        If InStr(TargetFile.Name, ".xlsx") > 0 Then
        
            'ブックを開く
            Workbooks.Open Filename:=TargetFile.Path
            
            '開いたブックを変数にセットする
            Set TargetBook = ActiveWorkbook
        
            '読み取り専用の場合は終了する
            If TargetBook.ReadOnly = True Then
            
                '開いたファイルを閉じる
                TargetBook.Close
                
                'アラート用の変数にファイル名を格納する
                MsgStr = MsgStr & TargetFile.Name & vbLf
             
            Else

                '開いたブックへ現在時刻を書き出す
                TargetBook.Worksheets("Sheet1").Range("A1") = Now()

                '開いたファイルを閉じる（保存する）
                TargetBook.Close SaveChanges:=True

            End If
        
        End If
        
    Next TargetFile
    
    '書き込みできなかったファイルがある場合はメッセージを表示
    If MsgStr <> "" Then
        MsgBox "下記のファイルには書き込みできませんでした。" & vbLf & MsgStr
      Else
        MsgBox "正常完了しました。"
    End If
        
    '変数の初期化・解放
    Set fso = Nothing
    Set TargetFile = Nothing
    Set TargetBook = Nothing
    
    'アラートの表示設定を戻す
    Application.DisplayAlerts = True
    
End Sub

    'FileSystemObjectのインスタンスを作成
    Set fso = CreateObject("Scripting.FileSystemObject")

    'フォルダ内のファイルをループ
    For Each TargetFile In fso.GetFolder(ForlderPath).Files
    
        'ファイルの拡張子が「.xlsx」の場合
        If InStr(TargetFile.Name, ".xlsx") > 0 Then
　　　　　　'（実行したい処理）
        End If
        
    Next TargetFile

            '読み取り専用の場合は終了する
            If TargetBook.ReadOnly = True Then
            
                '開いたファイルを閉じる
                TargetBook.Close
                
                'アラート用の変数にファイル名を格納する
                MsgStr = MsgStr & TargetFile.Name & vbLf
             
            Else

                '開いたブックへ現在時刻を書き出す
                TargetBook.Worksheets("Sheet1").Range("A1") = Now()

                '開いたファイルを閉じる（保存する）
                TargetBook.Close SaveChanges:=True

            End If

    '書き込みできなかったファイルがある場合はメッセージを表示
    If MsgStr <> "" Then
        MsgBox "下記のファイルには書き込みできませんでした。" & vbLf & MsgStr
      Else
        MsgBox "正常完了しました。"
    End If