VBA URL error checking

P

plotting

New Member
Joined
Jun 13, 2016
Messages
21
I have the following VBA
VBA Code: 
Public Sub FetchInfo2()
    Dim newURL$
    Dim S$, oItem As Object
    Dim propertyId$, living$, Value$, Sqft$, marketValue$, address$
    Dim propID    As Range
    
    With Sheets("PropertyIDs")
        For Each propID In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            
            newURL = "http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id=" & propID.Value
            
            With CreateObject("MSXML2.XMLHTTP")
                .Open "GET", newURL, False
                .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.97 Safari/537.36"
                .send
                S = .responseText
            End With
            
            
            With CreateObject("HTMLFile")
                .write S
                For Each oItem In .getElementsByTagName("td")
                    If InStr(oItem.innerText, "Property ID:") > 0 Then
                        propertyId = oItem.NextSibling.innerText
                        Exit For
                    End If
                Next oItem
                
            For Each oItem2 In .getElementsByTagName("td")
                If InStr(oItem2.innerText, "Address:") > 0 Then
                address = oItem2.NextSibling.innerText
                    Exit For
                End If
            Next oItem2
                
                living = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(2).innerText
                Value = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(3).innerText
                Sqft = .getElementById("landDetails").getElementsByTagName("td")(4).innerText
                marketValue = .getElementById("landDetails").getElementsByTagName("td")(7).innerText
                
                Range("A" & propID.Row) = propertyId
                Range("b" & propID.Row) = Left(living, Len(living) - 5)
                Range("c" & propID.Row) = Right(Value, Len(Value) - 1)
                Range("d" & propID.Row) = Sqft
                Range("e" & propID.Row) = Right(marketValue, Len(marketValue) - 1)
                Range("f" & propID.Row) = address
            End With
        Next propID
    End With
End Sub

Occasionally the propID value doesn't load because of an issue on their end, how could I put a check in to get the statustext = ok then continue else go to next propID. I've tried a few lines of code like that and can't get it to work.
 

Excel Facts

Create a Pivot Table on a Map
If your data has zip codes, postal codes, or city names, select the data and use Insert, 3D Map. (Found to right of chart icons).
Sort by date Sort by votes
VBA Code: 
Sub Macro1()
Dim xmlhttp As Object
Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
newURL = "http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id="
For Each propID In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
With xmlhttp
    .Open "GET", newURL, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.97 Safari/537.36"
    .send
    S = .responseText
End With

If xmlhttp.Status <> 200 Then
   Exit For
Else
        ' call success_task()
End If
next propID
 
Upvote 0
Thanks for that, I'm running into the same issues I was previous, I'm guessing it has something to do with the website doesn't error but going to a bad propID redirects to Property Search this instead of giving what is probably an actually HTML error code

VBA Code: 
Public Sub FetchInfo2()
    Dim newURL$
    Dim S$, oItem As Object
    Dim propertyId$, living$, Value$, Sqft$, marketValue$, address$
    Dim propID    As Range
    Dim xmlhttp As Object
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    
    With Sheets("PropertyIDs")
        For Each propID In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            
            newURL = "http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id=" & propID.Value
            
            With xmlhttp
                .Open "GET", newURL, False
                .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.97 Safari/537.36"
                .send
                S = .responseText
            End With
            
            If xmlhttp.Status <> 200 Then
                Exit For
            Else
            With CreateObject("HTMLFile")
                .write S
                For Each oItem In .getElementsByTagName("td")
                    If InStr(oItem.innerText, "Property ID:") > 0 Then
                        propertyId = oItem.NextSibling.innerText
                        Exit For
                    End If
                Next oItem
                
            For Each oItem2 In .getElementsByTagName("td")
                If InStr(oItem2.innerText, "Address:") > 0 Then
                address = oItem2.NextSibling.innerText
                    Exit For
                End If
            Next oItem2
                
                living = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(2).innerText
                Value = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(3).innerText
                Sqft = .getElementById("landDetails").getElementsByTagName("td")(4).innerText
                marketValue = .getElementById("landDetails").getElementsByTagName("td")(7).innerText
                
                Range("A" & propID.Row) = propertyId
                Range("b" & propID.Row) = Left(living, Len(living) - 5)
                Range("c" & propID.Row) = Right(Value, Len(Value) - 1)
                Range("d" & propID.Row) = Sqft
                Range("e" & propID.Row) = Right(marketValue, Len(marketValue) - 1)
                Range("f" & propID.Row) = address
            End With
            End If
        Next propID
    End With
End Sub

So then I get Run-time error '91'" Object variable or With block variable not set for
VBA Code: 
living = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(2).innerText
Guessing the redirect still gives status of 200 and this is why? FWIW all bad links redirect to the same spot so maybe that could be used to check?
 
Upvote 0
you have to check for some string in the response that will be available only if property search was found.
for eg.
VBA Code: 
Public Sub FetchInfo2()
    Dim newURL$
    Dim S$, oItem As Object
    Dim propertyId$, living$, Value$, Sqft$, marketValue$, address$
    Dim propID    As Range
    Dim xmlhttp As Object
    Set xmlhttp = CreateObject("MSXML2.XMLHTTP")
    
    With Sheets("PropertyIDs")
        For Each propID In .Range("A1", .Range("A" & Rows.Count).End(xlUp))
            
            newURL = "http://bexar.trueautomation.com/clientdb/Property.aspx?cid=110&prop_id=" & propID.Value
            
            With xmlhttp
                .Open "GET", newURL, False
                .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; ) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.97 Safari/537.36"
                .send
                S = .responseText
            End With
            
            If xmlhttp.Status <> 200 Then
                Exit For
            End If
' =====================
            Dim int1 As Integer
            int1 = InStr(S, "improvementBuildingDetails")
            If int1 <= 0 Then
                Exit For
            End If
' =====================
            With CreateObject("HTMLFile")
                .write S
                For Each oItem In .getElementsByTagName("td")
                    If InStr(oItem.innerText, "Property ID:") > 0 Then
                        propertyId = oItem.NextSibling.innerText
                        Exit For
                    End If
                Next oItem
                
            For Each oItem2 In .getElementsByTagName("td")
                If InStr(oItem2.innerText, "Address:") > 0 Then
                address = oItem2.NextSibling.innerText
                    Exit For
                End If
            Next oItem2
                
                living = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(2).innerText
                Value = .getElementById("improvementBuildingDetails").getElementsByTagName("td")(3).innerText
                Sqft = .getElementById("landDetails").getElementsByTagName("td")(4).innerText
                marketValue = .getElementById("landDetails").getElementsByTagName("td")(7).innerText
                
                Range("A" & propID.Row) = propertyId
                Range("b" & propID.Row) = Left(living, Len(living) - 5)
                Range("c" & propID.Row) = Right(Value, Len(Value) - 1)
                Range("d" & propID.Row) = Sqft
                Range("e" & propID.Row) = Right(marketValue, Len(marketValue) - 1)
                Range("f" & propID.Row) = address
            End With
            
        Next propID
    End With
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

I
  • Question Question
Please help..scrap data from website
Replies
0
Views
781
imran ashraf
I

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top