Sub ie_favoriten_in_tabelle()
Set WshShell = CreateObject("WScript.Shell")
Set fso = CreateObject("Scripting.FileSystemObject")
strFavoriten = WshShell.SpecialFolders("favorites")
With Application.FileSearch
.NewSearch
.LookIn = strFavoriten
.SearchSubFolders = True
.FileType = msoFileTypeAllFiles
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
If LCase(fso.getExtensionName(.FoundFiles(i))) = "url" Then
Set urlfile = fso.OpentextFile(.FoundFiles(i))
Do
adresse = urlfile.readline
gefunden = InStr(LCase(adresse), "url=")
If gefunden > 0 Then
adresse = Mid(adresse, gefunden + 4)
Exit Do
End If
Loop While urlfile.AtEndOfStream <> True
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Cells(i, 1), Address:=adresse, _
TextToDisplay:=fso.GetBaseName(.FoundFiles(i))
End If
Next i
End If
End With
ActiveSheet.Columns.AutoFit
Set WshShell = Nothing
Set fso = Nothing
End Sub
Kurze Rückmeldung bitte nicht vergessen.
MfG Anton