【ExcelVBA】全ファイルを再帰処理でルートフォルダに移動

Option Explicit
'サブフォルダ内のファイルを全てルートに移動する
Sub subFolderCut()
    Dim rootPath As String
        
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "ルートフォルダを選択"
        .AllowMultiSelect = False
        'キャンセルされたら抜ける
        If .Show = False Then
            MsgBox "フォルダが選択されませんでした"
            Exit Sub
        End If
        rootPath = .SelectedItems(1)
    End With
    
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim rootFld As Object
    Set rootFld = FSO.GetFolder(rootPath)
    
    'サブフォルダの存在確認
    If rootFld.SubFolders.Count <> 0 Then
        'サブフォルダ内ファイル移動処理へ
        Call MoveFiles(rootFld, rootPath)
    Else
        MsgBox "サブフォルダはありません！"
    End If
　　MsgBox "ファイルの移動処理終了！"
    Set FSO = Nothing
    Set rootFld = Nothing
End Sub

'再起処理で全ファイル移動する引数（フォルダーObject, rootPath文字列）
Sub MoveFiles(Fld As Object, rootPath As String)
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Dim f As Variant
    Dim subFld As Object
    
    'フォルダー内にサブフォルダーがなくなるまで再帰する
    For Each subFld In Fld.SubFolders
        Call MoveFiles(subFld, rootPath) '再帰処理へ
        subFld.Delete '処理が終わったフォルダーを削除する
    Next
    
    Dim fname As String
    Dim attNo As String
    Dim ext As String
    Dim pos As Long
    'ファイル移動処理
    For Each f In Fld.Files
        fname = ""  '一旦初期化する
        On Error GoTo Err_FileExist
        Call FSO.MoveFile(f, rootPath & "\" & fname)
        On Error GoTo 0
    Next
    Set FSO = Nothing
    Exit Sub
    
Err_FileExist:
    Select Case Err.Number
        Case 58   'ファイル名重複エラーの場合(FileExist)
            If fname = "" Then
                fname = f.Name 'ファイル名取得
            End If
            '拡張子部分をカット
            ext = Right(fname, Len(fname) - InStrRev(fname, ".") + 1)
            fname = Left(fname, Len(fname) - Len(ext))
            pos = InStrRev(fname, "_")  '"_"の位置確認
            If pos > 0 Then             '"_"以下の数字部分を見る
                attNo = Right(fname, Len(fname) - pos)
                If IsNumeric(attNo) Then
                    attNo = Val(attNo) + 1 '数値をインクリメント
                    fname = Left(fname, pos) & attNo & ext '付け替える
                Else
                    fname = fname & "_1" & ext '無い場合は"_1"を付ける
                End If
            Else
                fname = fname & "_1" & ext '"_"が無い場合"_1"を付ける
            End If
            Resume
        Case Else   'その他のエラーの場合はエラー表示して中断
            Err.Raise Err.Number, , Err.Description
        End Select
End Sub