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.
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>