doppelte Hyperlink

Sub Dateien_Search_Listing()
Dim fsObjekt As Object, index As Integer
Dim C               As Range
Dim datErweiterung  As String
Dim Meldung         As String
Dim letzteZeile     As String
Dim DataOption1     As String
Dim intPos          As Integer
Dim strLink         As String
Dim sPath           As Variant
Application.ScreenUpdating = False
'Auswahl Laufwerk/Pfad mit Inputbox
sPath = InputBox( _
prompt:="Verzeichnis:", _
Default:="E:\Daten\")    'anpassen wenn default gewünscht
'Default:=CurDir)
If sPath = "" Then Exit Sub
Range("B11").Value = sPath
Set fsObjekt = Application.FileSearch
With fsObjekt
ChDir sPath
.NewSearch
.LookIn = sPath              '  "C:\Daten\"  'anpassen Suchort
.SearchSubFolders = True
Range("A1:A2000").ClearContents
Meldung = "Bitte Dateiendung festlegen. Erlaubte *SUFFIX*." & vbCrLf & vbCrLf & vbTab & _
"*.xls             --->  Excel-Daten" & vbCrLf & vbTab & _
"*.doc             --->  Word-Daten" & vbCrLf & vbTab & _
"*.pdf;mp3;txt   --->  ANDERE "
Do
datErweiterung = Application.InputBox(Meldung, "mögliche DATEIENDUNGEN", "*.")
If datErweiterung = "" Or datErweiterung = "*." Then Exit Sub
Loop Until (datErweiterung = "*.xls" Or datErweiterung = "*.doc" Or datErweiterung = "*.pdf" Or datErweiterung = "*.mp3" Or datErweiterung = "*.txt")
.Filename = datErweiterung
If .Execute() > 0 Then
For index = 1 To .FoundFiles.Count
Cells(index, 1) = .FoundFiles(index)
Next index
End If
End With
letzteZeile = Range("A2000").End(xlUp).Row   ' Bereich für Hypererstellung
Range("A1:A" & letzteZeile).Select           'Abgrenzung benutzte Zellen
For Each C In Selection
intPos = InStrRev(C.Value, "\")
strLink = Right(C.Value, Len(C) - intPos)
C.Hyperlinks.Add C, C.Value, TextToDisplay:=strLink
Next C
Range("C8").Select
'Call sort
Application.ScreenUpdating = True
'ActiveWorkbook.Save
Range("c8").Select
End Sub