Gruppe
Extern
Bereich
Wsh
Thema
Absolute Adresse eines Hyperlinks feststellen
Problem
Aus dem Hyperlink in Zelle A1 soll die absolute Adresse ermittelt werden. WindowsScriptingHost muss installiert sein.
Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.
StandardModule: Modul1
Sub GetFileName()
Dim fs As Object
Dim f As Object
Dim iChar As Integer
Dim sFolder As String, sOrdner As String, sFile As String
Dim sPathR As String, sPathA As String
sPathR = ThisWorkbook.Path
sFolder = Range("A1").Hyperlinks(1).Address
If InStr(sFolder, "..\") Then
For iChar = Len(sFolder) To 1 Step -1
If Mid(sFolder, iChar, 1) = "\" Then Exit For
Next iChar
sFile = Right(sFolder, Len(sFolder) - iChar)
sOrdner = WorksheetFunction.Substitute(sFolder, "..\", "")
sOrdner = Left(sOrdner, InStr(sOrdner, "\"))
Set fs = CreateObject("Scripting.FileSystemObject")
Do While InStr(sFolder, "..\")
Set f = fs.GetFolder(sPathR)
sPathR = WorksheetFunction.Substitute(sPathR, "\" & f.Name, "", 1)
sFolder = WorksheetFunction.Substitute(sFolder, "..\", "", 1)
Loop
Set fs = Nothing
Set f = Nothing
sFile = sPathR & "\" & sOrdner & sFile
Else
sFile = ThisWorkbook.Path & "\" & sFile
End If
MsgBox sFile
End Sub