[Eine Seite zurück] [Übersicht] [Eine Seite vor]

Benutzung auf eigene Gefahr !
Keine Garantie für garnichts !

Absoluten in relativen Pfad umwandeln

Sprache / Programm: Excel ab Version 2000 · VBA ab Office 2000
Beschreibung

Die Funktion wandelt einen absoluten Pfad in einen relativen Pfad, relativ zu einem zweiten Pfad, um. Damit kann z.B. in einer Arbeitsmappe ein Hyperlink mit einem Pfad erstellt werden, der relativ zur Arbeitsmappe ist. Wenn dann die Arbeitsmappe und das Ziel des Hyperlinks zusammen verschoben werden, z.B. auf CD, bleibt der Hyperlink gültig.

VBA-Quelltext
Public Function RelativePath(ByVal SwitchToRelative As String, ByVal AbsolutePath As String) As String
    Dim Pos As Long, NewPath As String,
FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
   
    On Error GoTo Fehler
    If Left(SwitchToRelative, 1) = "." Then
        RelativePath = SwitchToRelative
        Exit Function
    End If
    If Left(AbsolutePath, 1) = "." Then Exit Function
   
    SwitchToRelative = Trim(SwitchToRelative)
    If Len(SwitchToRelative) < 2 And Mid(SwitchToRelative, 2) = ":" Then SwitchToRelative = SwitchToRelative & "\"
    SwitchToRelative = FSO.GetAbsolutePathName(SwitchToRelative)
   
    AbsolutePath = Trim(AbsolutePath)
    If Len(AbsolutePath) < 2 And Mid(AbsolutePath, 2) = ":" Then AbsolutePath = AbsolutePath & "\"
    AbsolutePath = FSO.GetAbsolutePathName(AbsolutePath)
   
   
    For Pos = 1 To WorksheetFunction.Min(Len(SwitchToRelative), Len(AbsolutePath))
        If LCase(Mid(SwitchToRelative, 1, Pos)) <> LCase(Mid(AbsolutePath, 1, Pos)) Then Exit For
    Next Pos
   
    Pos = WorksheetFunction.Max(InStrRev(Mid(SwitchToRelative, 1, Pos - 1), "\"), InStrRev(Mid(SwitchToRelative, 1, Pos - 1), ":"))
    SwitchToRelative = Mid(SwitchToRelative, Pos + 1)
    AbsolutePath = Mid(AbsolutePath, Pos + 1)
   
    Pos = InStr(1, AbsolutePath, "\")
    While Pos > 0
        NewPath = "..\" & NewPath
        AbsolutePath = Mid(AbsolutePath, Pos + 1)
        Pos = InStr(1, AbsolutePath, "\")
    Wend
   
    RelativePath = NewPath & SwitchToRelative
Fehler:
End Function
Argumente der Funktion/Prozedur

SwitchToRelative

Absoluter Pfad, der in einen relativen Pfad umgewandelt werden soll. Dieses Argument wird umgewandelt und von der Funktion zurückgegeben.

AbsolutePath

Pfad, der als Bezug für den relativen Pfad dient. Darf auch einen Dateinamen beinhalten.

Rückgabewert

Relativer Pfad des Arguments SwitchToRelative. Falls der Pfad bereits mit einem . (Punkt) beginnt, wird keine Änderung durchgeführt.

Anwendungsbeispiel(e)...

Im Code liefert RelativePath("C:\WINDOWS\winhlp32.exe","C:\") den relativen Pfad "WINDOWS\winhlp32.exe"

In Excel liefert

Zelle A1: "C:\WINDOWS\winhlp32.exe"

Zelle B1: "C:\WINDOWS\system32\"

Zelle C1: "=RelativePath(A1;B1)" die Anzeige "winhlp32.exe"

Hinweis

Die Funktion lässt sich auch als Tabellenfunktion in Excel einsetzen. Der zweite Pfad AbsolutePath darf auch ein Dateiname sein, den die Funktion ignoriert.

Wenn der Deklarationsteil des VBA-Moduls

    Private FSO As New Scripting.FileSystemObject

enthält und die Bibliothek "Microsoft Scripting Runtime" verwiesen wird, dann muss im Code der Funktion auf

    Dim FSO As Object

    Set FSO = CreateObject("Scripting.FileSystemObject")

verzichtet werden.

Anwendungsgebiete, Fehler und Warnungen

  1. Relative Pfade können nur erstellt werden, wenn beide Pfade im gleichen Laufwerk liegen.

  2. Die Funktion prüft nicht, ob die Pfade tatsächlich existieren.