vba получает имя папки из пути к файлу

---

Пожалуйста, руководство к ОТО имя папки из пути

Я пытался получить имя файла, но не смог получить имя папки

Вот мой код

Sub GetselectedPath()

    Dim fd As FileDialog
    Dim i As Integer
    Dim pth As String
    Dim sPath As String
    Dim sFile As String
    Dim foldname As String
    Dim fso As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileExt As String
    Set fd = Application.FileDialog(3)
    With fd
        .AllowMultiSelect = True
        .Title = "Select Folder"
        .InitialFileName = "C:\" 'intial directory
      
        If .Show = -1 Then
        For i = 1 To .SelectedItems.Count
        pth = .SelectedItems(1)
        sFile = FileName(.SelectedItems(i), sPath)
        'MsgBox sPath & "---" & sFile
        
    FromPath = sPath  '<< Change
    ToPath = "C:\00temp\00 WinRar\"    '<< Change
    FileExt = sFile  '<< Change
    'You can use *.* for all files or *.doc for word files
    If Right(FromPath, 1) <> "\" Then
        FromPath = FromPath & "\"
    End If
    Set fso = CreateObject("scripting.filesystemobject")
    If fso.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If
    If fso.FolderExists(ToPath) = False Then
        MsgBox ToPath & " doesn't exist"
        Exit Sub
    End If
        fso.Copyfile source:=FromPath & FileExt, Destination:=ToPath
             Next
             MsgBox "You can find the files from " & FromPath & " in " & ToPath
             End If
    End With
    Set fd = Nothing
    End Sub
    Public Function FileName(ByVal strPath As String, sPath) As String
    sPath = Left(strPath, InStrRev(strPath, "\"))
    FileName = Mid(strPath, InStrRev(strPath, "\") + 1)
    End Function

Здесь мне нужно получить имя папки, из которой я выбрал файлы.

---