VBA, IE getelements, change to xml http

[jamescooper]

How would I adapt the following code please so I could get it into a XMLHTTP web pull instead? e.g.

Private Function getprices(ByVal URL As String) As Variant
Dim source As Object
Dim Http As New XMLHTTP60, Html As New HTMLDocument
Dim ret(1 To 1) As String
Dim elem As Object


    With Http
        .Open "GET", URL, False
        .send
        Html.body.innerHTML = .responseText
    End With

Sub Getalllinks_tescos()


Dim IE As Object: Set IE = CreateObject("InternetExplorer.Application")
Dim cnt As Long: cnt = 1
Dim AR() As Variant: AR = Range("A1:A19").Value
Dim AL() As Variant
Dim url_name As String


IE.Visible = True


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


    On Error Resume Next
    
    Set AllHyperlinks = IE.Document.getElementsByClassName("product-list-container")(0).getElementsByTagName("A")


    For Each hyper_link In AllHyperlinks
        If InStr(hyper_link.href, "https://www.tesco.com/groceries/en-GB/products/") Then
            ReDim Preserve AL(1 To cnt)
            AL(cnt) = hyper_link.href
            cnt = cnt + 1
        End If
    Next
Next i


IE.Quit

End Sub

 

[strooman]

Your question is a little bit unclear to me. I'm not sure what you trying to achieve.
What is the Url you want to navigate? In your declaration section I read: "Dim url_name As String". But that variable never get's a value assigned to it.
Are you trying to fetch the Url's from a webpage?

So consider the beneath code as a long shot. I used a random url in this example:

Option Explicit
Sub GetHyperlinks()
'****************************************************************************
'Set references to:
'Microsoft Internet Controls
'Microsoft HTML Object Library
'Microsoft XML, v6.0
'Hit Alt+F11 to go to the Visual Basic Editor and then hit:
'Tools | References
'****************************************************************************
    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim htmlDoc As New MSHTML.HTMLDocument
    Dim URL As String
    Dim hLinks As MSHTML.IHTMLElementCollection
    Dim hLink As MSHTML.IHTMLElement
    
    'Create URL and sent request
    URL = "https://finance.yahoo.com/"
    XMLPage.Open "GET", URL, False
    XMLPage.send
    
    'Get the source (code) of the webpage
    htmlDoc.body.innerHTML = XMLPage.responseText
    
    'Set reference to all hyperlinks in htmlDoc.body.innerHTML
    Set hLinks = htmlDoc.getElementsByTagName("a")
    
    'Loop through all hyperlink-tags . . .
    For Each hLink In hLinks
        
        '. . . and display the hyperlink
        Debug.Print hLink.href
            
    Next hLink
    
End Sub

 

[jamescooper]

Thanks that is a great start. I adapted for my link and worked.

I am trying to get it to go into the excel sheet, so I have this but just needs a little re-work I think:

Option Explicit


Sub Get_Links()
    
    Dim Lastrow     As Long
    Dim LastRow2    As Long
    Dim x           As Long
    Dim urls        As Variant
    Dim Prices      As Variant
    Dim LR          As Long
   
    Lastrow = Sheets("Sheet1").Columns("Q").Find("*", , xlValues, , xlRows, xlPrevious).Row
    urls = Sheets("Sheet1").Range("Q1:Q" & Lastrow).Value


    For x = LBound(urls) To UBound(urls)
        Prices = getprices(urls(x, 1))
    Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, 7).End(xlUp).Offset(1).Resize(, UBound(Prices)).Value2 = Prices
    Next x


End Sub


Private Function getprices(ByVal URL As String) As Variant


    Dim XMLPage As New MSXML2.XMLHTTP60
    Dim htmlDoc As New MSHTML.HTMLDocument
    Dim hLinks As MSHTML.IHTMLElementCollection
    Dim hLink As MSHTML.IHTMLElement
    Dim ret(1 To 5) As String
    
    'Create URL and sent request
    XMLPage.Open "GET", URL, False
    XMLPage.send
    
    'Get the source (code) of the webpage
    htmlDoc.body.innerHTML = XMLPage.responseText
    
    'Set reference to all tables in htmlDoc.body.innerHTML
    Set hLinks = htmlDoc.getElementsByClassName("product-list-container")(0).getElementsByTagName("A")
    
    'Loop through all hyperlink-tags . . .
    For Each hLink In hLinks
        
        '. . . and display the hyperlink
        Debug.Print hLink.href
            
    Next hLink


    getprices = ret
    
End Function