Library code snippets
Relative References to Files
By Nick Avery, published on 28 Feb 2002
I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.
I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.
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
Related articles
Related discussion
-
Run-time error '91'
by crazyidane (0 replies)
-
Problem handling Redirects with MSXML2.XMLHTTP
by brandoncampbell (2 replies)
-
vbinputbox pauses code while it waits on response. How can I reproduce that?
by brandoncampbell (1 replies)
-
Sending SMS in VB 6
by sirobnole (6 replies)
-
Comboxbox listindex in ActiveX Control
by brandoncampbell (1 replies)
This thread is for discussions of Relative References to Files.