[FAQ] Obtenir un chemin relatif [Fait]

[cafeine]

Hello, voici une petite fonction pour obtenir un chemin relatif.

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Function GetRelativePath(ByVal strPath As String, Optional ByVal strPathCurrent As String)

Dim tmpCurr() As String
Dim tmpP() As String
Dim i As Integer
Dim iIndex As Integer

' par défaut on considère que c'est relatif par rapport au chemin courant de la base


If strPathCurrent = "" Then strPathCurrent = CurrentProject.Path
If Right(strPathCurrent, 1) = "\" Then strPathCurrent = Left(strPathCurrent, Len(strPathCurrent) - 1)

If Left(strPath, 1) = Left(strPathCurrent, 1) Then
    ' on recherche la partie commune aux deux chemins


    tmpP = VBA.Split(strPath, "\")
    tmpCurr = VBA.Split(strPathCurrent, "\")
    For iIndex = 0 To IIf(UBound(tmpP) > UBound(tmpCurr), UBound(tmpCurr), UBound(tmpP))
        If tmpP(iIndex) <> tmpCurr(iIndex) Then
            Exit For
        Else
            i = iIndex
        End If
    Next iIndex
    If i = UBound(tmpCurr) Then
        ' c'est un sous répertoire


        For iIndex = i + 1 To UBound(tmpP)
            GetRelativePath = GetRelativePath & tmpP(iIndex) & "\"
        Next iIndex
        GetRelativePath = Left(GetRelativePath, Len(GetRelativePath) - 1)
    Else
        ' il faut remonter de UBound(tmpCurr) - i


        For iIndex = 1 To UBound(tmpCurr) - i
            GetRelativePath = GetRelativePath & "..\"
        Next iIndex
        For iIndex = i + 1 To UBound(tmpP)
            GetRelativePath = GetRelativePath & tmpP(iIndex) & "\"
        Next iIndex
        GetRelativePath = Left(GetRelativePath, Len(GetRelativePath) - 1)
    End If
Else
    ' deux lecteurs différents


    GetRelativePath = strPath
End If

End Function

Pour l'utiliser, un exemple

Code :

1
2
?getrelativepath("c:\toto\tata\prout.xls","c:\tintin")
..\toto\tata\prout.xls

[philben]

Bonjour,

je me demande si la fonction <IsMissing> ne fonctionne qu'avec un type variant et non avec un type simple type string ?

Amicalement,

Philippe

[Tofalu]

Je dirais comme toi philben Il me semble que IsMissing fonctionne comme IsEmpty

Pour moi, impossible de faire un IsMissing sur une chaine de caractère.

J'aurais tendance à faire :

Function GetRelativePath(ByVal strPath As String, Optional ByVal strPathCurrent As String="")

if strPathCurrent ="" then ...