CODEWITHSUNDEEP
xmlvbaexcelweb-scraping
SIM
SIM

Reputation: 22440

Can't extract links out of xml content

I've wrtten a script in vba to get all the links within different nodes out of a sitemap link but can't make a go successfully.

How can I fetch those links?

This is what I've tried already:

Sub TestXML()
    Dim Http As New XMLHTTP60, Xmldoc As Object
    Dim post As Object, R&

    With Http
        .Open "GET", "https://www.klerenmakendebaby.nl/product-sitemap.xml", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        Set Xmldoc = CreateObject("MSXML2.DOMDocument")
        Xmldoc.LoadXML .responseXML.xml
    End With

    For Each post In Xmldoc.SelectNodes("//url")
        R = R + 1: Cells(R, 1) = post.SelectNodes(".//loc")(0).Text
    Next post
End Sub

Upon execution It fetches nothing, not throws any error either.

Upvotes: 0

Views: 93

Answers (2)

QHarr
QHarr

Reputation: 84465

As per the following? Add a reference to Microsoft XML Library for your version. I am on Excel 2016 so using xml 6.0. and document60. 

Option Explicit
Public Sub TestXML()
    Dim Http As New XMLHTTP60, Xmldoc As New MSXML2.DOMDocument60, R&, aNodeList As Object, bNode As IXMLDOMNode
    Application.ScreenUpdating = False
    With Http
        .Open "GET", "https://www.klerenmakendebaby.nl/product-sitemap.xml", False
        .setRequestHeader "User-Agent", "Mozilla/5.0" 
        .send
        Xmldoc.LoadXML .responseText
    End With
    Set aNodeList = Xmldoc.DocumentElement.SelectNodes("//loc")
    For Each bNode In aNodeList.Context.ChildNodes
        R = R + 1: Cells(R, 1) = bNode.FirstChild.Text
    Next bNode
    Application.ScreenUpdating = True
End Sub

Upvotes: 1

SIM
SIM

Reputation: 22440

Another way to achieve the same is like:

Sub TestXML()
    Dim Http As New XMLHTTP60
    Dim Xdoc As New DOMDocument, post As Object, R&

    With Http
        .Open "GET", "https://www.klerenmakendebaby.nl/product-sitemap.xml", False
        .setRequestHeader "User-Agent", "Mozilla/5.0"
        .send
        Xdoc.LoadXML .responseText
    End With

    For Each post In Xdoc.getElementsByTagName("url")
        R = R + 1: Cells(R, 1) = post.getElementsByTagName("loc")(0).Text
    Next post
End Sub

Upvotes: 1

Related Questions