Benutzung auf eigene Gefahr ! |
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 |
|
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 |
|