Library code snippets
Relative References to Files
By Nick Avery, published on 28 Feb 2002
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
I am as a web developer for a small company, working for a small company. I work on banking websites and verious related projects.
Related articles
Related discussion
-
VB6, SQL 2005 & DMO
by elajaunie3 (1 replies)
-
sending sms from pc
by sriraj20074 (0 replies)
-
Automating Excel from VB6.0
by epurdy (0 replies)
-
VB6 system conversion using VBA to Word 2007
by b.macgregor@vodamail.co.za (0 replies)
-
video not working with visual basic
by Jupiter 2 (9 replies)
Related podcasts
-
Christian Beauclair
14 mai 2008 (�mission #0074) ::.Christian Beauclair: Stratégies de migration VB6 vers .NET Nous discutons avec Christian Beauclair des stratégies de migration VB6 vers .NET. Entre autres, nous discutons comment utiliser le "VB 6 Code Advisor" et le "Interop Forms Toolkit" pour ajouter la puiss...
This thread is for discussions of Relative References to Files.