絶対パスの全階層のパスを変数化できるVBA

Option Explicit
'絶対パスを配列変数化します
    Dim AbsPath() As String

Sub 絶対パス取り出し()
    Dim OrigPath As String
    Dim Fullleng As Long
'絶対パスの一文字ずつ配列変数に代入します
    Dim Lett() As String
    Dim t, n, s As Long
'インプットボックスで絶対パスを入力します
        OrigPath = InputBox("最下層までの絶対パスを入力", _
                    Title:="絶対パス入力")
        If OrigPath = "" Then Exit Sub
'入力した絶対パスの文字列長を取得します
        Fullleng = Len(OrigPath)
'配列変数を再定義します
        ReDim Lett(1 To Fullleng)
        ReDim AbsPath(Fullleng)
        n = 0
        For t = 1 To Fullleng
'絶対パスの文字を一つずつ配列変数に代入します
            Lett(t) = Mid(OrigPath, t, 1)
'「\」記号があった時階層が変わるコードを仕込みます
            If Lett(t) = "\" Then
'「\」記号が出た時それまでの文字を再結合します。
'半角スペースが混ざりますので、すべて削除します
                'AbsPath(n) = Replace(Join(Lett), " ", "")
                AbsPath(n) = Join(Lett, "")
'カウンターnを1つ増やします
                n = n + 1
'「\」記号が出た時の回数（t回）をsとして保存します
                s = t
            End If
        Next t
'最下層を別に設定します
        AbsPath(n) = AbsPath(n - 1) & Right(OrigPath, Fullleng - s) & "\"
'これで配列変数AbsPathに各層の絶対パスが代入されました
        MsgBox "階層は " & n & " 階層になりました"

'----　ここから結果の解説用（使用時には不要）　----


        MsgBox "絶対パスを変数化しました" & vbCrLf & _
        "第0階層：　" & AbsPath(0) & vbCrLf & _
        "第1階層：　" & AbsPath(1) & vbCrLf & _
        "第2階層：　" & AbsPath(2) & vbCrLf & _
        "第3階層：　" & AbsPath(3) & vbCrLf & _
        "第4階層：　" & AbsPath(4) & vbCrLf & _
        "第5階層：　" & AbsPath(5) & vbCrLf & _
        "第6階層：　" & AbsPath(6) & vbCrLf & _
        "第7階層：　" & AbsPath(7) & vbCrLf & _
        "第8階層：　" & AbsPath(8)

'----　実際の使用TEST用（使用時には不要）　----
'----　「'」シングルクォーテーションを外します----
        'Workbooks.Add
        'ActiveWorkbook.SaveAs AbsPath(n) & "test.xlsx"
End Sub

Option Explicit
'絶対パスを配列変数化します
'モジュール内で有効な変数設定です
    Dim AbsPath() As String

Sub 利用テスト()
        Call 絶対パス取り出し
        Workbooks.Add
        On Error Resume Next
        ActiveWorkbook.SaveAs AbsPath(5) & "test.xlsx"
End Sub

'インプットボックスで絶対パスを入力します
        OrigPath = InputBox("最下層までの絶対パスを入力", _
                    Title:="絶対パス入力")
        If OrigPath = "" Then Exit Sub

　　OrigPath = "C:\Users\Public\AAAAA\BBBBB\CCCCC\DDDDD\EEEEE\FFFFF"

　　OrigPath = Worksheets("Sheet1").Range("B2").Value

　　MsgBox "階層は " & n & " 階層になりました"