【ExcelVBA・マクロ】エクセルでフォルダ内のファイル名を一括変更するVBAコード

Private Sub changeName_Click()
    
    Dim fd As FileDialog
    Dim fs As Object
    Dim path As String
    Dim i As Long
    Dim lastRow As Long
    Dim oldName As String
    Dim newName As String
    Dim oldExt As String
    Dim newExt As String
    Dim fso As Object
    Dim renamedCount As Long
    Dim skippedCount As Long

    
    ' フォルダ選択ダイアログ（再度選ばせる）
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "変更を適用するフォルダを選択してください"
        If .Show <> -1 Then Exit Sub
        path = .SelectedItems(1)
        If Right(path, 1) <> "\" Then path = path & "\"
    End With

    Set fso = CreateObject("Scripting.FileSystemObject")
    lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row

    renamedCount = 0
    skippedCount = 0
    
    
    With ActiveSheet
    
        For i = 2 To lastRow
            oldName = Trim(.Cells(i, 1))
            newName = Trim(.Cells(i, 2))
    
            If oldName = "" Or newName = "" Then GoTo SkipLine
    
            oldExt = LCase(fso.GetExtensionName(oldName))
            newExt = LCase(fso.GetExtensionName(newName))
    
            ' 拡張子が一致していない場合はスキップ
            If oldExt <> newExt Then
                .Cells(i, 3).Value = "拡張子不一致"
                skippedCount = skippedCount + 1
                GoTo SkipLine
            End If
    
            If fso.FileExists(path & oldName) Then
                Name path & oldName As path & newName
                .Cells(i, 3).Value = "変更済"
                renamedCount = renamedCount + 1
            Else
                .Cells(i, 3).Value = "ファイルなし"
                skippedCount = skippedCount + 1
            End If
    
SkipLine:
        Next i
    
        MsgBox "ファイル名の変更が完了しました。" & vbCrLf & _
               "変更されたファイル: " & renamedCount & " 件" & vbCrLf & _
               "スキップされたファイル: " & skippedCount & " 件", vbInformation
           
    End With
End Sub