Error handling

[jamescooper]

Hello,

If the VBA below cannot find anything for the particular pull I'd like it to Goto 1: and put a blank/1, can anyone help?

Thanks.

Public Sub Data_Pull_Products_and_Prices_2()


Dim http As Object, html As New HTMLDocument, topics As Object, topics2 As Object, titleElem As Object, topic As HTMLHtmlElement
Dim i As Integer
Dim j As Integer
Dim rngURL As Range
Dim LastRow As Long
Dim LastRow2 As Long


Application.ScreenUpdating = False


Set http = CreateObject("MSXML2.XMLHTTP")


For Each rngURL In Worksheets("Sheet1").Range("E1", Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp))


http.Open "GET", rngURL, False
http.send
html.body.innerHTML = http.responseText


DoEvents


Set topics = html.getElementsByClassName("product-tile-wrapper")


i = 1


For Each topic In topics
On Error GoTo 1:
Set titleElem = topic.getElementsByTagName("DIV")(0)
Sheets(1).Cells(i, 1).Value = titleElem.getElementsByTagName("p")(0).innerText
i = 1 + LastRow


1: """


Next


Next


Application.ScreenUpdating = True


End Sub

 

[JonXL]

Hello,

If the VBA below cannot find anything for the particular pull I'd like it to Goto 1:

You can get rid of the colon at the end of the 'Goto 1'. (You might also consider a more meaningful label.)

... and put a blank/1, can anyone help?

Where do you want to put a blank? And where do you want to put a 1? And how do you decide which of those you are putting wherever you're putting it?

 

[jamescooper]

So each time that code runs it will try and grab the element from the 48 on screen, if it doesn't find it, I want it to put a blank.

So for example:

Successful pull
""
Successful pull
Successful pull
""


etc..

 

[jamescooper]

Range("E1") =https://www.tesco.com/groceries/en-GB/shop/fresh-food/all?include-children=true&page=1

Ultimately this is what I am trying to do, if it doesn't find "Sorry, this product is currently unavailable" then put the price.

Public Sub Data_Pull_Products_and_Prices_2()


Dim http As Object, html As New HTMLDocument, topics As Object, topics2 As Object, titleElem As Object, topic As HTMLHtmlElement
Dim i As Integer
Dim j As Integer
Dim rngURL As Range
Dim LastRow As Long
Dim LastRow2 As Long


Application.ScreenUpdating = False


Set http = CreateObject("MSXML2.XMLHTTP")


For Each rngURL In Worksheets("Sheet1").Range("E1", Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp))


http.Open "GET", rngURL, False
http.send
html.body.innerHTML = http.responseText


DoEvents


i = 1


Set topics = html.getElementsByClassName("product-tile-wrapper")


For Each topic In topics
0
On Error GoTo 1
Set titleElem = topic.getElementsByTagName("DIV")(0)
Sheets(1).Cells(i, 1).Value = titleElem.getElementsByTagName("p")(0).innerText
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
i = 1 + LastRow


Next


1


Set topics2 = html.getElementsByClassName("price-control-wrapper")


For Each topic In topics2
Set titleElem = topic.getElementsByTagName("div")(0)
Sheets(1).Cells(i, 1).Value = titleElem.getElementsByTagName("span")(0).innerText
i = 1 + LastRow


GoTo 0


Next


Next


Application.ScreenUpdating = True


End Sub

 

[Norie]

James

What error are you trying to 'handle'?

 

[jamescooper]

Hello Norie,

If it cannot find

"Sorry, this product is currently unavailable" from the first pull of Topics, skip to the Topics2 and pull the price.

Then repeat it but for the second item and populate according.

The code above needs to loop for the URL: https://www.tesco.com/groceries/en-GB/shop/fresh-food/all?include-children=true&page=1

Does that make sense?

Thanks.

 

[Norie]

What happens in the code if 'Sorry...' isn't found?

Do you get an error along the lines of 'Object not set...'?

If you do then there's probably a better way to handle it than On Error. and Goto.

 

[jamescooper]

Yes I do,
So with that code and the above URL in E1.

I get in

A1: 'Sorry...'
A2: £1.60

But then it fails to the error you mentioned above on:

Sheets(1).Cells(i, 1).Value = titleElem.getElementsByTagName("p")(0).innerText

The next time around.

 

[Norie]

What you can do is something like this.

Dim Res As Variant

    ' other code
    Set Res =  titleElem.getElementsByTagName("p")(0)

    If Not Res Is Nothing Then
        Sheets(1).Cells(i, 1).Value = Res.innerText
    Else
        Sheets(1).Cells(i,1).Value = "Not found"
    End If

You can use something like this whenever you have a similar problem.

 

[jamescooper]

That is great, so it populates correctly. So could I now replace the line:

[COLOR=#333333]        Sheets(1).Cells(i,1).Value = "Not found"[/COLOR]

With a line which pulls something else:

i.e.

Set topics2 = html.getElementsByClassName("price-control-wrapper")


For Each topic In topics2
Set titleElem = topic.getElementsByTagName("div")(0)
Sheets(1).Cells(i, 1).Value = titleElem.getElementsByTagName("span")(0).innerText
i = 1 + LastRow