ysa1441, the problem here is that if you were a user of the program, you would be "forced" to select a file.

Also, the common dialog box lets you change disks which I precieved to be a part of the problem (whats the relative path from c:\apps to d:\test ?)

With Gillles second message though, it is clear that he wants to have the ".." in the relative path name.

This new example although alot more complex is still only using simple non-API based ideas. It might help I hope.

Even if it doesn't it provides one method of breaking a path down into components which you can then manipulate any way you like.

Code:
Private Sub Command1_Click()
  Dim startPath As String
  startPath = "c:\" 'put your full path here
  Debug.Print "Relative path from " & startPath & " to " & Dir1.List(Dir1.ListIndex)
  
  Debug.Print GetRelativePath(Dir1.List(Dir1.ListIndex), startPath)
End Sub

Public Function GetRelativePath(path As String, relativeTo As String) As String
    
  ' fast exit for special case
  If path = relativeTo Then
    GetRelativePath = ".\"
    Exit Function
  End If
   
  
  Dim res As String
  Dim myPath() As String
  Dim relPath() As String
  
  myPath = GetPathFromString(path)
  relPath = GetPathFromString(relativeTo)
            
  Dim c, startPos, pathLen, relLen As Integer
  pathLen = UBound(myPath)
  relLen = UBound(relPath)
  
  If InStr(1, path, relativeTo) > 0 Then
    ' the entire relative to is within the path
    res = ".\"
    startPos = relLen + 1
  Else
    res = ""
    startPos = 0
  End If
    
  ' get the rest of the path
  For c = startPos To pathLen
    If c <= relLen Then
      If relPath(c) = myPath(c) Then
        res = res & "..\"
      Else
        res = res & myPath(c) & "\"
      End If
    Else
      res = res & myPath(c) & "\"
    End If
  Next
  
  GetRelativePath = res
End Function
Function GetPathFromString(path As String) As String()
  ' returns an array of strings representing the "path" to a file
  ' based on the common notation of A:\path1\path2
  ReDim myPath(0) As String
  Dim lastpos, pos, c As Integer
  c = 0
  pos = 0
  Do
    lastpos = pos
    pos = InStr(pos + 1, path, "\")
    If pos > 0 Then
      myPath(c) = Mid(path, lastpos + 1, pos - lastpos - 1)
      If pos < Len(path) Then
        c = c + 1
        ReDim Preserve myPath(c)
      End If
    Else
      myPath(c) = Mid(path, lastpos + 1, Len(path) - lastpos)
    End If
  Loop Until pos = 0
  GetPathFromString = myPath
End Function
Private Sub Form_Load()
  Dir1.path = "c:\"
End Sub