Hi Max,
Something like:
Sub UpdateFavorites()
Dim sFolder As String
sFolder = CreateObject("WScript.Shell").SpecialFolders("Favorites")
Dim sFile$, sLink$, f&, p%, i%: i = 1
With ThisWorkbook.Sheets(1)
Do While .Cells(i, 1) <> ""
sLink = Mid$(.Cells(i, 1), 8)
p = InStr(1, sLink, "www.", 1)
If p Then sLink = Mid$(sLink, p + 4)
sLink = Mid$(sLink, 1, InStr(1, sLink, ".") - 1)
sFile = sFolder & "\" & sLink & ".url"
f = FreeFile
Open sFile For Output As #f
Print #f, "[InternetShortcut]"
Print #f, "URL=" & .Cells(i, 1)
Close #f
i = i + 1
Loop
End With
End Sub
MP