[HaBo]

    Public QuellSpalte, ZielSpalte As Integer
    Public verz As String
    Private changingRow As Integer
    
Private Sub Worksheet_Activate()
    QuellSpalte = 1 ' A
    ZielSpalte = 3 ' C
    verz = Environ("UserProfile") + "\Desktop" ' zu durchsuchendes verz ... hier: %USERPROFILE%\Desktop
    changingRow = 0
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim quelle, ziel As String
    Dim cell As Range
    
    If Target.row = changingRow Then
        Exit Sub
    End If
    For Each cell In Target
        If (cell.Column = QuellSpalte Or cell.Column = ZielSpalte) And cell.Count = 1 Then
            quelle = Conversion.CStr(Cells(cell.row, QuellSpalte).Value)
            ziel = Conversion.CStr(Cells(cell.row, ZielSpalte).Value)
            If quelle = "" And ziel <> "" Then
                Cells(cell.row, ZielSpalte).Value2 = ""
                Cells(cell.row, ZielSpalte).Hyperlinks.Delete
            ElseIf quelle <> "" Then
                setupLink (cell.row)
            End If
        End If
    Next cell
    
End Sub

Private Sub setupLink(row As Integer)
    Dim quelle As String
    Dim fso As Object
    Dim file As Object
        

    quelle = Conversion.CStr(Cells(row, QuellSpalte))
    Set fso = CreateObject("Scripting.FilesystemObject")
    getFileOrNothing fso, quelle, verz, file
    changingRow = row
    If Not file Is Nothing Then
        Hyperlinks.Add Cells(row, ZielSpalte), file.path, "", "", "Link to " + file.Name
    Else
        Cells(row, ZielSpalte).Value2 = "Fehler: Datei nicht gefunden"
        Cells(row, ZielSpalte).Hyperlinks.Delete
    End If
    changingRow = 0
    
End Sub

Private Sub getFileOrNothing(fso As Object, fileName As String, path As String, ByRef file_out As Object)

    Dim f As String
    Dim pathDir As Object
    Dim subdir As Object
    Dim file As Object
    
    Set file_out = Nothing
    
    Set pathDir = fso.getFolder(path)
    For Each file In pathDir.Files
        If file.Name Like fileName + ".*" Then
            Set file_out = file
            Exit Sub
        End If
    Next file
    For Each subdir In pathDir.SubFolders
        getFileOrNothing fso, fileName, subdir.path, file_out
        If Not file_out Is Nothing Then
            Exit Sub
        End If
    Next subdir
End Sub