Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Bewerten Sie hier bitte das Excel-Portal

Home Zurück Vor

Download Beispiel-Arbeitsmappe

Thema

Absolute Adresse eines Hyperlinks feststellen

Gruppe

Wsh

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