vba get folder name from file path

See more:

MS-Access

VBA

Please Guide to grt the folder name from the path

I have tried and get the file name but not able to get the folder name

Here is my code

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

Here i need to get the folder name from where I have selected the files.