Solved: Retreiving IE Favorites in a Userform

[bryVA]

Hello,

I am trying to retreive internet explorers favorites from the computer the file is on and place the names in a listbox or combobox and when you select one it automatically opens an internet explorer and brings up the favorite webpage. Is this possible?

My goal is to have a userform that has links to programs and a combobox with all the favorites in it so that the userform has easy access to open up the most used programs and websites.

Thanks in advance:thumb . You all are awesome with helping me out :friends: .

[georgiboy]

If you open IE then click on the Add favorites button then select "Import and Export..." then hit "Next" then selcct "Export favorites" then hit "Next" then hit "Next" then set the save location to the "C:\" drive then hit "Next" and then "Finish".
You have now exported your favorites to the C drive, now you can open the excel file i have provided and it will import these favs and place them in a userform where you can select and launch then in IE.

Hope this helps

George

[omnibuster]

Thanks georgiboy.
Very usefull.

[bryVA]

Georgiboy that is great. Thank you so much for all your help. One last question that process of saving the favorites to the C: Drive can that also be done with a Macro? The reason I ask is some people will have a hard time following those simple instructions. Can that process be automated?

Again thanks so much for all your help. You guys are so knowledgeable and are so great helping me out.

[georgiboy]

This is a bit cumsy but it is my best attempt...

In this bit of code within Module1 of this workbook you will need to change the red line to the dir of your favorites folder...

Sub Auto_Open()
Dim MyFile As String
Dim URL_ As String
Dim FullURL As String
Dim x As Long
Dim FavFile As String

Application.ScreenUpdating = False

FavFile = "C:\Example\Example\favorites\"

MyFile = Dir(FavFile & "*.url")

Do While MyFile <> ""
ChDir FavFile
Workbooks.OpenText Filename:=FavFile & MyFile _
, Origin:=xlMSDOS, StartRow:=1

URL_ = Range(ActiveWorkbook.ActiveSheet.Cells.Find("BASEURL").Address).Value
FullURL = Right(URL_, Len(URL_) - 8)

x = x + 1

With ThisWorkbook.Sheets("Favs")
.Range("A" & x).Value = FullURL
End With

ActiveWorkbook.Close False

MyFile = Dir()
Loop
Hope this helps

[p45cal]

treat this as work in progress; I've tried to find the user's favourites folder automatically by using late binding to the shell and the filesystem objects, I've tried to take the original favourites' names and urls and put them in a list box on the userform (of course you don't have to display the actual url in the listbox at all).
Things still to do include:
Using recursion to look through the full depth of the folders below the favourites folder instead of it just lookng at the root.
Change the way urls are opened (so that if another browser is the default it will use that instead (there's a follow link command somewhere - I haven't looked at this part of the code at all save for adding a visible=true statement).
Remove the hard coded 1 from Line Input #1 and use freefile to assign the number.
And more..

Anyway, I attach the workbook and the code in module1 below:Function FavesPath()
Dim WSHShell As Object
Set WSHShell = CreateObject("Wscript.Shell")
' MsgBox "Favourites is located here: " & WSHShell.SpecialFolders("Favorites")
FavesPath = WSHShell.SpecialFolders("Favorites")
Set WSHShell = Nothing
End Function
Function ShCutsArray()
Dim ShCutsArrayTemp()
r = 0
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set zzz = fso.GetFolder(FavesPath)
For Each fl In zzz.Files
If fl.Type = "Internet Shortcut" Then
'MsgBox "Shortcut name = " & fl.Name & ", url = " & TheUrl(fl)
ReDim Preserve ShCutsArrayTemp(0 To 1, 0 To r)
ShCutsArrayTemp(0, r) = fl.Name
ShCutsArrayTemp(1, r) = TheUrl(fl)
r = r + 1
End If
Next fl
ShCutsArray = ShCutsArrayTemp
End Function
Function TheUrl(myfile)
Open myfile For Input As #1 ' Open file.
Do While Not EOF(1) ' Loop until end of file.
Line Input #1, TextLine ' Read line into variable.
If Left(TextLine, 4) = "URL=" Then
TheUrl = Mid(TextLine, 5)
Exit Do
End If
Debug.Print TextLine ' Print to the Immediate window.
Loop
Close #1 ' Close file.
End Function

[p45cal]

The attached includes changes suggested in the previous post, so it now recurses into the full depth of subfolders in the favourites folder, uses the user's default browser by using FollowHyperlink (the only trouble is, if they don't use IE then their favourites folder will be a bit short! - I wonder if there's something similar to find the favourites in FireFox?), and uses FreeFile.
The code from Module1:Function ShCutsArray()
Dim ShCutsArrayTemp()
r = 0
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set zzz = fso.GetFolder(FavesPath)
GrabShortcuts zzz, ShCutsArrayTemp, r
ShCutsArray = ShCutsArrayTemp
End Function

Sub GrabShortcuts(zzz, ShCutsArrayTemp, r)
For Each fl In zzz.Files
If fl.Type = "Internet Shortcut" Then
'MsgBox "Shortcut name = " & fl.Name & ", url = " & TheUrl(fl)
ReDim Preserve ShCutsArrayTemp(0 To 1, 0 To r)
ShCutsArrayTemp(0, r) = fl.Name
ShCutsArrayTemp(1, r) = TheUrl(fl)
r = r + 1
End If
Next fl
For Each fldr In zzz.SubFolders
GrabShortcuts fldr, ShCutsArrayTemp, r
Next fldr
End Sub

Function FavesPath()
Dim WSHShell As Object
Set WSHShell = CreateObject("Wscript.Shell")
' MsgBox "Favourites is located here: " & WSHShell.SpecialFolders("Favorites")
FavesPath = WSHShell.SpecialFolders("Favorites")
Set WSHShell = Nothing
End Function

Function TheUrl(myfile)
InputFile = FreeFile
Open myfile For Input As #InputFile ' Open file.
Do While Not EOF(1) ' Loop until end of file.
Line Input #InputFile, TextLine ' Read line into variable.
If Left(TextLine, 4) = "URL=" Then
TheUrl = Mid(TextLine, 5)
Exit Do
End If
Debug.Print TextLine ' Print to the Immediate window.
Loop
Close #InputFile ' Close file.
End Function

[bryVA]

Wow thanks Georgiboy and p45cal you guys are amazing. P45cal the example you gave will pull the userform up and it pulls the favorites into the combobox however when I click the command button it brings up the internet explorer but it freezes excel up. I can't get back into excel. Is it my version of Excel that is having a problem or is there something else?

Again thanks for all your help. You guys are awesome.

[bryVA]

By the way P45cal it was the 2nd attachment that was giving me that problem. The first one you posted didn't give me that problem.

Thanks for all your help,

[p45cal]

It doesn't freeze on me (xl2003) but because the userform's still open, you can choose to open another site with the userform, but other parts of excel won't be available until you close the userform - this is normal excel behaviour. If you can't immediately see the userform, try the Alt-Tab method to get to it.
Try changing the Showmodal property of the userform to False and see if you get the behaviour you want.

[bryVA]

Awesome that worked switching it to modeless. Thanks so much for all your help. Sure hope I can learn this. I would love to be able to help others as you guys have so generously helped me.

Thanks again,

Bryan