Option Explicit
Sub hyperlink_dynamisch()
Dim aktuellerpfad As String
Dim fso As Object
Dim unterordner As Object
Dim ordner As Object
Dim nordner As String
Dim dateien As Object
Dim datei As Object
Dim dateiname As String
aktuellerpfad = Left(ActiveWorkbook.FullName, InStrRev(ActiveWorkbook.FullName, "\"))
If Right(aktuellerpfad, 1) <> "\" Then aktuellerpfad = aktuellerpfad & "\"
Set fso = CreateObject("Scripting.Filesystemobject")
Set unterordner = fso.GetFolder(aktuellerpfad).subfolders
For Each ordner In unterordner
nordner = ordner.Name
Exit For
Next ordner
If nordner = "" Then
MsgBox "Kein Ordner vorhanden!", , "Keinen Ordner gefunden"
End
End If
Set dateien = fso.GetFolder(aktuellerpfad & nordner)
For Each datei In dateien.Files
dateiname = datei.Name
Exit For
Next datei
If dateiname = "" Then
MsgBox "Keine Datei vorhanden!", , "Keine Datei gefunden"
End
End If
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A1"), Address:=aktuellerpfad & nordner & "\" & dateiname, _
TextToDisplay:=aktuellerpfad & nordner & "\" & dateiname
End Sub