These two functions create and read relative file locations just like you would use in HTML.
Public Function FindFile(ByVal ReferenceString As String, ByVal CurentLocation As String) As String
'handle bad paramiters
If CurentLocation = "" Then
FindFile = ReferenceString
Exit Function
End If
If Right(Left(ReferenceString, 3), 2) = ":\" Then 'This reference is hardly a reference
FindFile = ReferenceString
Exit Function
End If
'Romove file from CurentLocation, if any
Do Until Right(CurentLocation, 1) = "\"
CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
Loop
'Move back the numbers of folders shown in ReferenceString
If Left(ReferenceString, 1) = "." Then
ReferenceString = Right(ReferenceString, Len(ReferenceString) - 1)
CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
Do Until Left(ReferenceString, 1) <> "."
Do Until Right(CurentLocation, 1) = "\"
CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
Loop
CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
ReferenceString = Right(ReferenceString, Len(ReferenceString) - 1)
Loop
End If
'add what left of the ReferenceString
FindFile = CurentLocation & ReferenceString
End Function
Public Function CompressFile(ByVal CurentLocation As String, ByVal FileLocation As String) As String
Dim X As Integer
Dim Y As Integer
Dim Levles As Integer
'Hanble bad paramiter
If CurentLocation = "" Then
CompressFile = FileLocation
Exit Function
End If
'Remove file name in CurentLocation, if any
Do Until Right(CurentLocation, 1) = "\"
CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
Loop
'Find ware the folders change
X = 1
Do Until Left(CurentLocation, X) <> Left(FileLocation, X)
X = X + 1
Loop
If X <= 3 Then
CompressFile = FileLocation
Exit Function
End If
'Remove the simaler parts
CurentLocation = Right(CurentLocation, Len(CurentLocation) - X + 1)
FileLocation = Right(FileLocation, Len(FileLocation) - X + 1)
'Count how many folders back we need to travel
Do Until CurentLocation = ""
If Right(CurentLocation, 1) = "\" Then
Levles = Levles + 1
End If
CurentLocation = Left(CurentLocation, Len(CurentLocation) - 1)
Loop
'Add the correct header
If Levles > 0 Then
FileLocation = ".\" & FileLocation
For Y = 1 To Levles
FileLocation = "." & FileLocation
Next
End If
CompressFile = FileLocation
End Function
Comments