Write all URLs to cells instead
Page 1 of 2 12 LastLast
Results 1 to 10 of 19

Thread: Write all URLs to cells instead
Thanks Thanks: 0 Likes Likes: 0

  1. #1
    Board Regular
    Join Date
    Sep 2014
    Posts
    611
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Write all URLs to cells instead

    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

  2. #2
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,381
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Write all URLs to cells instead

    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
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  3. #3
    Board Regular
    Join Date
    Sep 2014
    Posts
    611
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Write all URLs to cells instead

    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 = Hyper_link
        RowNum = RowNum + 1
    Next
    
    IE.Quit
    End Sub

  4. #4
    Board Regular
    Join Date
    Sep 2014
    Posts
    611
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Write all URLs to cells instead

    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 = Hyper_link
        RowNum = RowNum + 1
    Next
    
    IE.Quit
    End Sub
    Thanks.
    Last edited by jamescooper; Aug 20th, 2019 at 07:38 PM.

  5. #5
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,381
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Write all URLs to cells instead

    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
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  6. #6
    Board Regular
    Join Date
    Sep 2014
    Posts
    611
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Write all URLs to cells instead

    Thanks that is fantastic, and to put the loop in I would amend?

  7. #7
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,381
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Write all URLs to cells instead

    I'm not sure what you mean.
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  8. #8
    Board Regular
    Join Date
    Sep 2014
    Posts
    611
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Write all URLs to cells instead

    Well, so I can use multiple URLs

    e.g.

    Code:
    url_name = Sheet1.Range("E4:E10")

  9. #9
    Board Regular lrobbo314's Avatar
    Join Date
    Jul 2008
    Location
    California
    Posts
    2,381
    Post Thanks / Like
    Mentioned
    4 Post(s)
    Tagged
    1 Thread(s)

    Default Re: Write all URLs to cells instead

    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
    To add code to a workbook. Hit Alt+F11. Hit Alt+I+M to insert new module. Then paste code.
    Array formulas must be entered by hitting Ctrl+Shift+Enter.

    We can't solve problems by using the same kind of thinking we used when we created them.

    Imagination is more important than knowledge.

  10. #10
    Board Regular
    Join Date
    Sep 2014
    Posts
    611
    Post Thanks / Like
    Mentioned
    1 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Write all URLs to cells instead

    Thanks, think missing a "Next" as getting error: "For without next"

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •