GetRelativePath

Public Function GetRelativePath(ByVal LINKINGFOLDER As String, ByVal LINKEDFOLDER As String)
LINKINGFOLDER = LCase(LINKINGFOLDER)
LINKEDFOLDER = LCase(LINKEDFOLDER)
Dim OLDarrLinking As Variant
Dim OLDarrLinked As Variant
Dim arrLinking As Variant
Dim arrLinked As Variant
Dim intFolderCountLinking As Integer
Dim intFolderCountLinked As Integer
Dim OLDintFolderCountLinking As Integer
Dim OLDintFolderCountLinked As Integer
Dim Folder As Variant ' as loop variable
Dim intCounter As Integer 'counts the folders
Dim copyOfintCounter As Integer
Dim prRelativePath As String
Dim SameFolder As Boolean
' init
intFolderCountLinking = -1
intFolderCountLinked = -1
intCounter = 0
SameFolder = True
'#
' make array out of the path
OLDarrLinking = Split(LINKINGFOLDER, "\")
OLDarrLinked = Split(LINKEDFOLDER, "\")
' whats the smaller path ?
For Each Folder In OLDarrLinking
intFolderCountLinking = intFolderCountLinking + 1
OLDintFolderCountLinking = intFolderCountLinking
Next Folder
For Each Folder In OLDarrLinked
intFolderCountLinked = intFolderCountLinked + 1
OLDintFolderCountLinked = intFolderCountLinked
Next Folder
' make array the same length of fields
Select Case intFolderCountLinking
Case intFolderCountLinked 'like case is >intfoldercountlinked AND like case is <intfoldercountlinked
ReDim arrLinked(intFolderCountLinking)
intCounter = -1
For Each Folder In OLDarrLinked
intCounter = intCounter + 1
arrLinked(intCounter) = OLDarrLinked(intCounter)
Next Folder
ReDim arrLinking(intFolderCountLinked)
intCounter = -1
For Each Folder In OLDarrLinking
intCounter = intCounter + 1
arrLinking(intCounter) = OLDarrLinking(intCounter)
Next Folder
Case Is > intFolderCountLinked
ReDim arrLinked(intFolderCountLinking)
intFolderCountLinked = intFolderCountLinking
' fill new array with the old values
intCounter = -1
For Each Folder In OLDarrLinked
intCounter = intCounter + 1
arrLinked(intCounter) = OLDarrLinked(intCounter)
Next Folder
arrLinking = OLDarrLinking
Case Is < intFolderCountLinked
ReDim arrLinking(intFolderCountLinked)
intFolderCountLinking = intFolderCountLinked
' fill new array with the old values
intCounter = -1
For Each Folder In OLDarrLinking
intCounter = intCounter + 1
arrLinking(intCounter) = OLDarrLinking(intCounter)
Next Folder
arrLinked = OLDarrLinked
End Select
'------------------------------------------------------------------------------------------------
' find last same root folder e.g. from c:\windows\system\test and c:\windows\something c:\windows is last same root
' compare from last element to first element
intCounter = -1
For Each Folder In arrLinked
intCounter = intCounter + 1
If arrLinked(intCounter) = arrLinking(intCounter) Then
' same
Else
SameFolder = False
Exit For
End If
Next Folder
If SameFolder = True Then 'exatly the same root
GetRelativePath = ""
Exit Function
End If
'------------------------------------------------------------------------------------------------
copyOfintCounter = intCounter 'last same folder
' add the subfolders you have to "go" on e.g. test/test2/test3...
Do Until copyOfintCounter = intFolderCountLinked + 1
If arrLinked(intFolderCountLinked - _
copyOfintCounter + intCounter) < > "" Then
prRelativePath = arrLinked(intFolderCountLinked - _
copyOfintCounter + intCounter) & "/" & prRelativePath
End If
copyOfintCounter = copyOfintCounter + 1
Loop
copyOfintCounter = intCounter 'last same folder
' add the folders (../) you have to "go" out
For Folder = 1 To OLDintFolderCountLinking - intCounter + 1
prRelativePath = "../" & prRelativePath
Next Folder
GetRelativePath = prRelativePath
End Function