Write all URLs to cells instead

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
834
Hello, the following code successfully pulls all the URL links from a webpage and puts them in a listbox; how do I modify to put in column A for example?

Thanks.

Code:
Sub Getalllinks()


Dim IE As Object


Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False


url_name = Sheet1.Range("E4")
If url_name = "" Then Exit Sub


IE.navigate (url_name)


Do
DoEvents
Loop Until IE.ReadyState = 4


Set AllHyperlinks = IE.Document.getElementsByTagName("A")
Sheet1.ListBox1.Clear


For Each hyper_link In AllHyperlinks
Sheet1.ListBox1.AddItem (hyper_link)
Next


IE.Quit


End Sub
 

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
This should do it.

Code:
Sub Getalllinks()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
url_name = Sheet1.Range("E4")
Dim RowNum As Long: RowNum = 1

If url_name = "" Then Exit Sub
IE.navigate (url_name)

Do
    DoEvents
Loop Until IE.ReadyState = 4

Set AllHyperlinks = IE.Document.getElementsByTagName("A")
Sheet1.ListBox1.Clear

For Each hyper_link In AllHyperlinks
    Sheet1.Range("A" & RowNum).Value = Hyperlink
    RowNum = RowNum + 1
Next

IE.Quit
End Sub
 
Upvote 0
Thanks, very good, just 1 minor change to make it run highlighted in red below.

Code:
Sub Getalllinks()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
url_name = Sheet1.Range("E4")
Dim RowNum As Long: RowNum = 1

If url_name = "" Then Exit Sub
IE.navigate (url_name)

Do
    DoEvents
Loop Until IE.ReadyState = 4

Set AllHyperlinks = IE.Document.getElementsByTagName("A")
Sheet1.ListBox1.Clear

For Each hyper_link In AllHyperlinks
    Sheet1.Range("A" & RowNum).Value = [COLOR=#ff0000]Hyper_link[/COLOR]
    RowNum = RowNum + 1
Next

IE.Quit
End Sub
 
Upvote 0
Would there be a way to:

1. Only pull URLs which start with http://www.awebsite.co.uk/123

(for example, instead of all)

2. To loop through multiple URLS, e.g. E4, E5, E6 etc..?

Code:
Sub Getalllinks()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
url_name = Sheet1.Range("E4")
Dim RowNum As Long: RowNum = 1

If url_name = "" Then Exit Sub
IE.navigate (url_name)

Do
    DoEvents
Loop Until IE.ReadyState = 4

Set AllHyperlinks = IE.Document.getElementsByTagName("A")
Sheet1.ListBox1.Clear

For Each hyper_link In AllHyperlinks
    Sheet1.Range("A" & RowNum).Value = [COLOR=#ff0000]Hyper_link[/COLOR]
    RowNum = RowNum + 1
Next

IE.Quit
End Sub
Thanks.
 
Last edited:
Upvote 0
This should do it.

Code:
Sub Getalllinks()
Dim IE As Object
Set IE = CreateObject("InternetExplorer.Application")
IE.Visible = False
url_name = Sheet1.Range("E4")
Dim RowNum As Long: RowNum = 1

If url_name = "" Then Exit Sub
IE.navigate (url_name)

Do
    DoEvents
Loop Until IE.ReadyState = 4

Set AllHyperlinks = IE.Document.getElementsByTagName("A")
Sheet1.ListBox1.Clear

For Each hyper_link In AllHyperlinks
    If InStr(hyper_link, "http://www.awebsite.co.uk/123") Then
        Sheet1.Range("A" & RowNum).Value = hyper_link
        RowNum = RowNum + 1
    End If
Next

IE.Quit
End Sub
 
Upvote 0
I see. Made some changes loading all the info into an arrays. Should make it run faster.

Code:
Sub Getalllinks()
Dim IE As Object: Set IE = CreateObject("InternetExplorer.Application")
Dim AL As Object: Set AL = CreateObject("System.Collections.ArrayList")
Dim AR() As Variant: AR = Range("E4:E" & Range("E" & Rows.Count).End(xlUp).Row).Value
IE.Visible = False
Dim url_name As String

For i = LBound(AR) To UBound(AR)
    url_name = AR(i, 1)

    If url_name = "" Then Exit For
    IE.navigate (url_name)

    Do
        DoEvents
    Loop Until IE.ReadyState = 4

    Set AllHyperlinks = IE.Document.getElementsByTagName("A")
    Sheet1.ListBox1.Clear

    For Each hyper_link In AllHyperlinks
        If InStr(hyper_link, "http://www.awebsite.co.uk/123") Then
            If Not AL.contains(hyper_link) Then AL.Add hyper_link
        End If
    Next

IE.Quit
Range("A1").Resize(AL.Count, 1).Value = Application.Transpose(AL.toarray)
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,534
Messages
6,114,186
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top