Import Hyperlinks

[Guest]

What is the easiest way to import hyperlinks into a worksheet using VBA?

For example if a folder (say Favorites) contains 100 hyperlinks (shortcuts),
I would like to populate a column of 100 cells each containing a hyperlink
with the appropriate Address and TextToDisplay.

 

[Jim Cone]

Hello GS (again)

If you don't need the actual code then my free Excel add-in "List Files"
does what you want and it is very easy to use.
You can download it from here...
http://www.realezsites.com/bus/primitivesoftware

Regards,
Jim Cone
San Francisco, USA


"Gary''s Student" <[email protected]>
wrote in message
What is the easiest way to import hyperlinks into a worksheet using VBA?

For example if a folder (say Favorites) contains 100 hyperlinks (shortcuts),
I would like to populate a column of 100 cells each containing a hyperlink
with the appropriate Address and TextToDisplay.

 

[Guest]

This might not be the coolest method, but it works. Move to a blank
worksheet before running:

Sub PostLinks()

Dim strLink As String
Dim lRow As Long

lRow = 1
strLink = Dir("C:\Documents and Settings\KBackm00\Favorites\Links\*.*")

Do Until strLink = ""
Cells(lRow, 1) = strLink
lRow = lRow + 1
strLink = Dir
Loop

strLink = ActiveCell.Value

Do Until strLink = ""
ActiveSheet.Hyperlinks.Add Anchor:=Selection, _
Address:=strLink
ActiveCell.Offset(1).Select
strLink = ActiveCell.Value
Loop


End Sub

 

[Guest]

Hi Gary,
The following seem to be working. You send a folder path and a range
destination to the ListHyperlinks sub. The code opens each file in ".url" and
extract the line starting with 'URL=' (Not sure if this is the syntax for all
url files though). Finally it writes the hyperlink vertically in the sheet as
a HYPERLINK function.

Regards,
Sebastien

'---------------------------------------------------------------------------
Sub test()
ListHyperlinks "C:\Temp\", Range("a1")
End Sub

Sub ListHyperlinks(path As String, Destination As Range)
Dim file As String, strLine As String
Dim CurCell As Range
Dim found As Boolean

If Destination Is Nothing Then Exit Sub
Set CurCell = Destination

'fix path
If path = "" Then path = CurDir()
path = path & IIf(Right(path, 1) = Application.PathSeparator, "",
Application.PathSeparator)

'loop through url files
file = Dir(path & "*.url")
Do While file <> ""

'Read url file
Open (path & file) For Input Access Read As #1
found = False
Do While (Not EOF(1) And Not found)
Line Input #1, strLine
'Extract url
If strLine Like "URL=*" Then
file = Left(file, Len(file) - 4) 'remove ".url"
strLine = Right(strLine, Len(strLine) - 4)
CurCell.Formula = "=HYPERLINK(""" & strLine & """,""" & file &
""")"
Set CurCell = CurCell.Offset(1, 0)
found = True
End If
Loop
Close #1
file = Dir()

Loop

End Sub
'--------------------------------------------------------

 

[Guest]

Jim, Kevin, and Sebastien:

Thank you all very much.

The time you have spent helping me with this and other issues has saved me
many hours and has inspired me to try (in a small way) to help others.