Danke
Sub Die_Favoriten_auslesen_mit_Link()
'-----Neue Mappe erstellen------
Sheets.Add
ActiveSheet.Name = "Favoriten"
Range("A1").Select
'-----Auslesen der Favoriten
Dim Dateiname As String, i As Integer
Pfad = "C:\WINDOWS\Favoriten\links\"
'Pfad = "C:\WINDOWS\Favoriten\links\alle\"
'Pfad = "C:\Übergang\xxx\"
Dateiname = Dir$(Pfad & "*.*")
Do While Dateiname <> ""
On Error Resume Next 'bei fehler zum nächsten gehen
ActiveCell.Offset(i, 0) = Left(Dateiname, Len(Dateiname) - 4)
Open Pfad & Dateiname For Input As #1
Do While Not EOF(1)
Line Input #1, s
If Left(s, 3) = "URL" Then ActiveCell.Offset(i, 1) = Mid(s, 5, Len(s) - 4)
Loop
Close #1
i = i + 1
Dateiname = Dir$()
Loop
End Sub