VBA web Scraping code Error linked with macro

Question

I have worked through this code I have created and it seem like i'm running into some problems. The code works fine when you manually step into the code and run it, but each time I try to run the code automatically with a macro button I run into a problem.

I receive a Run-time error '70': permission denied. i'm not to sure why the code is tripping up and throwing this code when I run it automatically.

The idea is to be able to type in a town and state in excel and it will search the two websites for data.

I have attached the code below

'start a new subroutine called SearchBot
Sub SearchBot1()

'dimension (declare or set aside memory for) our variables
Dim objIE As InternetExplorer 'special object variable representing the IE browser
Dim aEle As HTMLLinkElement 'special object variable for an <a> (link) element
Dim HTMLinputs As MSHTML.IHTMLElementCollection
Dim y As Integer 'integer variable we'll use as a counter
Dim result As String 'string variable that will hold our result link

'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = New InternetExplorer

'make IE browser visible (False would allow IE to run in the background)
'objIE.Visible = True

'navigate IE to this web page (a pretty neat search engine really)
objIE.navigate "https://www.zillow.com/orange-county-ny/home-values/"

'wait here a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

'in the search box put cell "A2" value, the word "in" and cell "C1" value
objIE.document.getElementById("local-search").Value = _
  Sheets("Sheet2").Range("B3").Value & ", " & Sheets("Sheet2").Range("B4").Value

'click the 'go' button
Set HTMLinputs = objIE.document.getElementsByTagName("button")
For Each input_element In HTMLinputs
If input_element.getAttribute("name") = "SubmitButton" Then

    input_element.Click
    Exit For
End If
Next input_element


'wait again for the browser
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop


'price for home

Set Doc = objIE.document
Dim cclass As String
cclass = Trim(Doc.getElementsByClassName("value-info-list")(0).Children(0).innerText)
'MsgBox (cclass)

Dim aclass As Variant
aclass = Split(cclass, " ")
Range("Market_Price").Value = aclass(0)


'1-YR Forecast
 cclass = Trim(Doc.getElementsByClassName("value-info-list")(0).Children(1).innerText)
'MsgBox (cclass)
 Dim bclass As Variant
bclass = Split(cclass, " ")
Range("yr_forecast").Value = bclass(0)

'Median List Price
 cclass = Trim(Doc.getElementsByClassName("value-info-list")(0).Children(2).innerText)
'MsgBox (cclass)
 Dim dclass As Variant
 dclass = Split(cclass, " ")
 Range("Median_List_Price").Value = dclass(0)

'Median Sale Price
 cclass = Trim(Doc.getElementsByClassName("value-info-list")(0).Children(3).innerText)
'MsgBox (cclass)
 Dim eclass As Variant
 eclass = Split(cclass, " ")
 Range("Median_Sale_Price").Value = eclass(0)

'Health of market

 cclass = Trim(Doc.getElementsByClassName("value-info-list")(1).Children(0).innerText)
'MsgBox (cclass)

 Dim fclass As Variant
 fclass = Split(cclass, " ")
 Range("Healthy").Value = fclass(0)

' Home with Negative Equity

 cclass = Trim(Doc.getElementsByClassName("value-info-list")(1).Children(1).innerText)
'MsgBox (cclass)

 Dim gclass As Variant
 gclass = Split(cclass, " ")
 Range("Home_With_Negative_Equity").Value = gclass(0)

'Delinquent on Mortgage

 cclass = Trim(Doc.getElementsByClassName("value-info-list")(1).Children(2).innerText)
'MsgBox (cclass)

 Dim hclass As Variant
 hclass = Split(cclass, " ")
 Range("Delinquent_On_Mortgage").Value = hclass(0)


'Listings with price cut

 cclass = Trim(Doc.getElementsByClassName("value-info-list")(2).Children(2).innerText)
'MsgBox (cclass)

 Dim iclass As Variant
 iclass = Split(cclass, " ")
 Range("Price_Cut").Value = iclass(0)


'Breakeven Horizon

 cclass = Trim(Doc.getElementsByClassName("value-info-list")(3).Children(2).innerText)
'MsgBox (cclass)

 Dim jclass As Variant
 jclass = Split(cclass, " ")
 Range("Breakeven").Value = jclass(0)

'Rent List Price

cclass = Trim(Doc.getElementsByClassName("value-info-list")(3).Children(3).innerText)
'MsgBox (cclass)

Dim kclass As Variant
kclass = Split(cclass, " ")
Range("Rent_List_Price").Value = kclass(0)

'Rent List Price/sq ft

 cclass = Trim(Doc.getElementsByClassName("value-info-list")(3).Children(4).innerText)
 'MsgBox (cclass)

 Dim lclass As Variant
 lclass = Split(cclass, " ")
 Range("Rent_sq").Value = lclass(0)

'close the browser
 objIE.Quit




Set ws = ThisWorkbook.Worksheets("Engine")

'initiating a new instance of Internet Explorer and asigning it to objIE
Set objIE = New InternetExplorer

'make IE browser visible (False would allow IE to run in the background)
'objIE.Visible = True

'navigate IE to this web page (a pretty neat search engine really)
objIE.navigate "https://datausa.io/profile/geo/" & ws.Range("City_Search").Value & "-" & ws.Range("State_Search").Value

'wait here a few seconds while the browser is busy
Do While objIE.Busy = True Or objIE.readyState <> 4: DoEvents: Loop

 Set Doc = objIE.document
 Dim Data As String
 Data = Trim(Doc.getElementsByClassName("stat")(0).Children(1).innerText)
'MsgBox (Data)

 Dim adata As Variant
 adata = Split(Data, "")
 ws.Range("Population").Value = adata(0)

  End Sub




  'exit our SearchBot subroutine

If anyone can help me out that would be appreciated. I will continue to problem solve to see if I can get it to work. If you have any questions about the formula please ask.

Thank you

QHarr · Accepted Answer · 2018-07-13 21:19:55Z

Notes on your code:

I cannot replicate your error. It is possible at some point you are hitting a captcha request. You can check this by setting objIE.Visible = True.
You are opening an instance of IE, quitting it, re-opening. You can just continue to use the existing and navigate to the new URL. This would reduce the amount of code.
You have undeclared variables which means you aren't using Option Explicit at the top of your code.
It is a little unclear which sheets you intend to work with at certain points as you don't fully qualify ranges with their parent sheet object. Hence my assumptions below. When you don't qualify, the range object will use the Activesheet.
Your population stat returns the decline % as well as the actual population figure - was that intended as you split a lot of your other results to get a substring?
By targeting the class value e.g. doc.getElementsByClassName("value"), you could then iterate over the returned collection and completely avoid using Split and reduce the amount of code substantially.
You can switch off Screen-Updating for faster results.
Depending on how frequently you are doing this, you could switch to XHR, as shown below, which is a lot faster.

My code:

I had to make a few assumptions but the following grabs the info from the pages. I am assuming that all the info is coming from, and going to, sheet2 except Population. I show it in the screenshot below just so you can see all the results together.

XHR and fiddler:

I used fiddler to inspect the web traffic whilst making a selection and pressing the search button. This showed me that a GET request was made and I used the information provided by fiddler's inspectors to formulate the correct GET request.

Fiddler results:

Note that if you attempt too many GET requests, in too short a time, you will end up with a captcha.

CSS selector:

Inspecting the HTML for the retrieved page I can see that all the relevant values have a className of value

I can target these elements by using a CSS selector of .value where the "." means class.

Sample of matched elements:

As there are many elements matched, I use the .querySelectorAll method of document to retrieve a NodeList containing all the matched items. I traverse the .Length of the NodeList to access the required values. I use Select Case to determine, by index position, which named range to write the value to. You may need to verify I have got this correct.

VBA:

Option Explicit
Public Sub GetInfo()
    Dim html As New MSHTML.HTMLDocument, ws As Worksheet
    Application.ScreenUpdating = False
    Set ws = ThisWorkbook.Worksheets("Sheet2")   '<== Must be sheet name where named ranges are
    Dim searchString As String, URL As String
    searchString = Replace$(LCase$(ws.Range("B3")), Chr$(32), Chr$(45)) & Chr$(45) & LCase$(ws.Range("B4")) 'Santa Ana in B3, CA in B4
    URL = "https://www.zillow.com/" & searchString & "/home-values/"

    html.body.innerHTML = GetHTML(URL)

    Dim aNodeList As Object, i As Long
    Set aNodeList = html.querySelectorAll(".value")
    With ws
        For i = 0 To aNodeList.Length - 1
            Select Case i
            Case 0 ' ZHVI
                .Range("Market_Price") = aNodeList.item(i).innerText
            Case 1                               ' 1-yr forecast
                .Range("yr_forecast") = aNodeList.item(i).innerText
            Case 2                               'Median listing price
                .Range("Median_List_Price") = aNodeList.item(i).innerText
            Case 3                               'Median sale price
                .Range("Median_Sale_Price") = aNodeList.item(i).innerText
            Case 4                               'Market Health Index
                .Range("Healthy") = aNodeList.item(i).innerText
            Case 5                               'Homes with negative equity
                .Range("Home_With_Negative_Equity") = aNodeList.item(i).innerText
            Case 6                               'Delinquent on mortgage
                .Range("Delinquent_On_Mortgage") = aNodeList.item(i).innerText
            Case 7                               'Median list price / sq ft
            Case 8                               'Median sale price / sq ft
            Case 9
            Case 10                              'Value Listings with price cut
                .Range("Price_Cut") = aNodeList.item(i).innerText
            Case 11                              'Breakeven horizon
                .Range("Breakeven") = aNodeList.item(i).innerText
            Case 12
                .Range("Rent_List_Price") = aNodeList.item(i).innerText ' Rent list price
            Case 13                              'List price / sq ft
                .Range("Rent_sq") = aNodeList.item(i).innerText
            End Select
        Next i

        URL = "https://datausa.io/profile/geo/" & searchString
        html.body.innerHTML = GetHTML(URL)
        ThisWorkbook.Worksheets("Engine").Range("Population") = html.querySelector(".stat-value").innerText
    End With

    Application.ScreenUpdating = True
End Sub
Public Function GetHTML(ByVal URL As String) As String
    Dim sResponse As String
    With CreateObject("MSXML2.XMLHTTP")
        .Open "GET", URL, False
        .send
        sResponse = StrConv(.responseBody, vbUnicode)
    End With
    GetHTML = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE "))
End Function

Results in sheet2:

References required:

HTML Object Library

Collectives™ on Stack Overflow

VBA web Scraping code Error linked with macro

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related