Write all URLs to cells instead

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
771
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
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,780
Office Version
365, 2019, 2016
Platform
Windows
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
 

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
771
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
 

jamescooper

Well-known Member
Joined
Sep 8, 2014
Messages
771
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:

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,780
Office Version
365, 2019, 2016
Platform
Windows
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
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,780
Office Version
365, 2019, 2016
Platform
Windows
I'm not sure what you mean.
 

lrobbo314

Well-known Member
Joined
Jul 14, 2008
Messages
2,780
Office Version
365, 2019, 2016
Platform
Windows
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,778
Messages
5,488,814
Members
407,658
Latest member
Arias610

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top