VBA Web Scraping from www.eppraisal.com

Question

I need to fetch data from www.eppraisal.com

So I have written following code but it's not working unfortunately:

Public Function GetEppraisalValuation()
    Dim strURL As String
    Dim strLocationURL As String

    Dim strEppraisalValue As String
    Dim strEppraisalHighLow As String

    Dim lngStartPointer As Long
    Dim lngEndPointer As Long

    'strAddressForWeb1 = "4189 E LAFAYETTE AVE"
    'strAddressForWeb2 = "GILBERT, AZ 85298"
    strURL = "http://www.eppraisal.com/home-values/property/1122-e-loyola-dr-tempe-az-85282-42382460/"

    Set zHttp = CreateObject("WinHttp.WinHttpRequest.5.1")
    zHttp.Open "GET", strURL, False
    zHttp.Option(iWinHttpRequestOption_EnableRedirects) = False
    zHttp.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
    zHttp.setRequestHeader "Accept-Encoding", "gzip, deflate"
    zHttp.setRequestHeader "Accept-Language", "en-us"
    zHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0)"
    zHttp.setRequestHeader "Referer", strURL
    zHttp.setRequestHeader "Connection", "Keep-Alive"
    zHttp.setRequestHeader "Host", "www.eppraisal.com"
    'zHttp.setRequestHeader "Cookie", "ASP.NET_SessionId=" & SessionID
    'zHttp.setRequestHeader "Cookie", ".ASPXAUTH=" & ASPXAUTH

    zHttp.send

    If zHttp.Status <> 302 Then
        Exit Function
    End If

    strLocationURL = zHttp.getResponseHeader("Location")

    strURL = "http://www.eppraisal.com" & strLocationURL
    'DeleteUrlCacheEntry (strURL)

    zHttp.Open "GET", strURL, False
    zHttp.Option(iWinHttpRequestOption_EnableRedirects) = True
    zHttp.setRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
    'zHttp.setRequestHeader "Accept-Encoding", "gzip, deflate"
    zHttp.setRequestHeader "Accept-Language", "en-us"
    zHttp.setRequestHeader "User-Agent", "Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; Trident/5.0)"
    zHttp.setRequestHeader "Referer", strURL
    zHttp.setRequestHeader "Connection", "Keep-Alive"
    zHttp.setRequestHeader "Host", "www.eppraisal.com"
    'zHttp.setRequestHeader "Cookie", "ASP.NET_SessionId=" & SessionID
    'zHttp.setRequestHeader "Cookie", ".ASPXAUTH=" & ASPXAUTH

    zHttp.send

    If zHttp.Status <> 200 Then
        Exit Function
    End If

    ieDom.body.innerHTML = zHttp.responseText
    For Each ieInp In ieDom.getElementsByTagName("p")
        If ieInp.className = "ColorAccent6 FloatLeft FontSizeK Margin0" Then
            strEppraisalValue = ieInp.innerText
            Exit For
        End If
    Next

    For Each ieInp In ieDom.getElementsByTagName("p")
        If ieInp.className = "FontSizeA FloatRight Margin0 DisplayNone HighLow" Then
            strEppraisalHighLow = ieInp.innerText
            Exit For
        End If
    Next

    wrkshtPI.Range("C1").Offset(intRowOffset, 0) = strEppraisalValue

    lngStartPointer = InStr(1, strEppraisalHighLow, "Low:")
    If lngStartPointer = 0 Then
        Exit Function
    End If
    lngEndPointer = InStr(1, strEppraisalHighLow, Chr(10))
    If lngEndPointer = 0 Then
        Exit Function
    End If
    wrkshtPI.Range("D1").Offset(intRowOffset, 0) = Trim(Mid(strEppraisalHighLow, lngStartPointer + 4, lngEndPointer - (lngStartPointer + 5)))
    wrkshtPI.Range("E1").Offset(intRowOffset, 0) = Trim(Mid(strEppraisalHighLow, lngEndPointer + 7, Len(strEppraisalHighLow) - (lngEndPointer + 7)))
End Function

The status code of zHTTP is not coming as 302 which is not valid. Also I am getting some junk values in ResponseBody.

I have highlighted the 3 figures I want to fetch in below screenshot.

Can anybody please suggest what exactly is going wrong?

Thanks.

Answer 1

Here you go

 Const URl As String = "http://www.eppraisal.com/home-values/property_lookup_eppraisal?a=1122%20E%20Loyola%20Dr&z=85282&propid=42382460"
Sub xmlHttp()
    Dim xmlHttp As Object
    Set xmlHttp = CreateObject("MSXML2.XMLHTTP")
    xmlHttp.Open "GET", URl, False
    xmlHttp.setRequestHeader "Content-Type", "text/xml"
    xmlHttp.send


    Dim html As Object
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = xmlHttp.ResponseText
    Debug.Print html.body.innerHTML
End Sub

Output on Immediate window

<P style="LINE-HEIGHT: 1.2em" class="ColorAccent6 FontBold FontSizeM Margin0 Padding0">$148,305</P>
<P style="LINE-HEIGHT: 1.1em" class="FontSizeA Margin0 DisplayNone HighLow">Low: $126,059 <BR>High: $170,550</P>

Answer 2

I had a similar problem, until I discovered that the Server responded with a gzip content, because I had also set "Accept-Encoding", "gzip, deflate".

I changed the request headers to: SetRequestHeader("Accept", "text/html;charset=UTF-8"); SetRequestHeader("Accept-Encoding", "identity" ); SetRequestHeader("Accept-Charset", "UTF-8" ); and then the Server responded with a text in Unicode.

Hope this helps... Michael