FEHLER: Makro liest Daten 5mal ein

Sub Datei_einlesen_Hyperlink()
' Listet alle Dateien als Hyperlink
Application.ScreenUpdating = False
Dim myFSO As Object
Dim myDrvList, myDrv, mySpace
Dim Dateiform As String, myStr As String
Dim geffile As String
Dim i As Long, totFiles As Long, chkHype As Integer
Dim oldStatus As Variant
Set myFSO = CreateObject("Scripting.Filesystemobject")
Set myDrvList = myFSO.drives
Application.ScreenUpdating = True
oldStatus = Application.StatusBar
On Error GoTo myErrHandler
Dateiform = "*.*"
If Dateiform = "" Then
Application.ScreenUpdating = True
Exit Sub
End If
For Each myDrv In myDrvList
If myDrv.IsReady Then
With myDrvList
myStr = "" & myDrv.DriveLetter & " - "
If myDrv.drivetype = 3 Then
myStr = myStr & myDrv.sharename & ": "
Else
myStr = myStr & myDrv.volumename & ": "
End If
Set mySpace = myFSO.getdrive(myFSO.getdrivename(myDrv.DriveLetter & ":"))
End With
With Application.FileSearch
.LookIn = "C:\Eigene Dateien\"
' .LookIn = mySpace
.SearchSubFolders = True 'True Unterverzeichnissen JA, False Unterverzeichnissen NEIN
.Filename = Dateiform
If .Execute() > 0 Then
totFiles = .FoundFiles.Count
Application.StatusBar = "Total " & totFiles & " in " & mySpace & " gefunden "
For i = 1 To .FoundFiles.Count
geffile = .FoundFiles(i)
Cells([A65536].End(xlUp).Row + 1, 1) = geffile
ActiveSheet.Hyperlinks.Add Anchor:=Cells([A65536].End(xlUp).Row, 1), Address:=geffile _
, TextToDisplay:=geffile
Selection.Font.ColorIndex = 2
Next i
End If
End With
End If
Next
ErrEntry:
Application.StatusBar = oldStatus
Application.ScreenUpdating = True
MyExit:
Close #1
Exit Sub
myErrHandler:
Select Case Err
Case 71
myStr = myStr & "Datenträger nicht bereit"
End Select
Resume ErrEntry
End Sub