VBA to Identify Webpart. Need IE HTML Expert.

[Barklie]

Hello,

I am trying to scrape data from a web query using VBA. The problem I have run into is that I can't find a way to copy the data I actually want. I have tried everything I could find on the forums (document.body document.innertext, document.outerHTML, etc.), but nothing is capturing the data I'm after. Below is my code as well as a screenshot of the data I would like to copy. I only want the first result in the query, but I am happy with pulling extraneous information (the whole page and all the results if necessary) as long as the data I want is included. I have tried to read through the HTML to find the location, but at this point I think it will take someone more talented with reading HTML than me.

Sub QueryScrape()

'Dimensions IE
Dim IE As Object

'Starts loop
Set IE = CreateObject("InternetExplorer.Application")
For i = 2 To 500
    strLink = "http://209.183.255.146/arcgis/rest/services/Solar/Buildings/MapServer/find?searchText=" & i - 1 & "&contains=false&searchFields=&sr=&layers=0&layerDefs=&returnGeometry=true&maxAllowableOffset=&geometryPrecision=&dynamicLayers=&returnZ=true&returnM=true&gdbVersion=&f=html"

'Opens IE
With IE
    .Visible = True
    .Navigate strLink
Do While IE.ReadyState <> 4
            DoEvents
Loop

'Moves data to worksheet
'Range ("A" & i) = WHERE I NEED A WAY TO REFERENCE THE DATA

'Closes IE
IE.Quit

End With

'Separates data into columns
'This is code I will write to separate the data from column A into columns A through L

Next i

End Sub

[/URL][/IMG]

 

[Barklie]

Hi Norie,

Thank you so much for you help. I've written the final program. It works perfectly when I step through it, but when I try to run it, it gives me either an Object Required or a Subscript Out of Ranger Error. Any idea why this might be?

Sub NSM_Scraper()

'Dimensions IE
Dim IE As Object
Dim I As Long
Dim strLInk As String

    Set IE = CreateObject("InternetExplorer.Application")

    'Starts loop
    For I = 2 To 10
        strLInk = "http://209.183.255.146/arcgis/rest/services/Solar/Buildings/MapServer/find?searchText=" & I - 1 & "&contains=false&searchFields=&sr=&layers=0&layerDefs=&returnGeometry=true&maxAllowableOffset=&geometryPrecision=&dynamicLayers=&returnZ=true&returnM=true&gdbVersion=&f=html"

        'Opens IE
        With IE
            .Visible = True
            .Navigate strLInk
            Do While IE.ReadyState <> 4
                DoEvents
            Loop

            'Moves data to worksheet
            QueryResult = Split(IE.document.body.innerhtml, "OBJECTID: </i> ")(1)

        End With

'Separates data into columns
Range("A" & I) = Left(QueryResult, Application.WorksheetFunction.Find("<br>", QueryResult) - 1)
Range("B" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("Shape", QueryResult) + 12, Application.WorksheetFunction.Find("Address", QueryResult) - 20 - Application.WorksheetFunction.Find("Shape", QueryResult))
Range("C" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("Address", QueryResult) + 14, Application.WorksheetFunction.Find("Area", QueryResult) - 22 - Application.WorksheetFunction.Find("Address", QueryResult))
Range("D" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("Area", QueryResult) + 11, Application.WorksheetFunction.Find("UsblArea", QueryResult) - 19 - Application.WorksheetFunction.Find("Area", QueryResult))
Range("E" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("UsblArea", QueryResult) + 15, Application.WorksheetFunction.Find("kWh", QueryResult) - 23 - Application.WorksheetFunction.Find("UsblArea", QueryResult))
Range("F" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("kWh", QueryResult) + 10, Application.WorksheetFunction.Find("PctArea", QueryResult) - 18 - Application.WorksheetFunction.Find("kWh", QueryResult))
Range("G" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("PctArea", QueryResult) + 14, Application.WorksheetFunction.Find("SysSize", QueryResult) - 22 - Application.WorksheetFunction.Find("PctArea", QueryResult))
Range("H" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("SysSize", QueryResult) + 14, Application.WorksheetFunction.Find("Savings", QueryResult) - 22 - Application.WorksheetFunction.Find("SysSize", QueryResult))
Range("I" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("Savings", QueryResult) + 14, Application.WorksheetFunction.Find("Shape_Length", QueryResult) - 22 - Application.WorksheetFunction.Find("Savings", QueryResult))
Range("J" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("Shape_Length", QueryResult) + 19, Application.WorksheetFunction.Find("Shape_Area", QueryResult) - 27 - Application.WorksheetFunction.Find("Shape_Length", QueryResult))
Range("K" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("Shape_Area", QueryResult) + 17, Application.WorksheetFunction.Find("<i>Polygon", QueryResult) - 22 - Application.WorksheetFunction.Find("Shape_Area", QueryResult))
Range("L" & I) = Mid(QueryResult, Application.WorksheetFunction.Find("<i>Polygon", QueryResult) + 20, Application.WorksheetFunction.Find("]", QueryResult) - 19 - Application.WorksheetFunction.Find("<i>Polygon", QueryResult))


    Next I

End Sub

 

[Barklie]

Yes, that's exactly what I want.

 

[Norie]

This should get you further along.

Option Explicit

Sub QueryScrape()

'Dimensions IE
Dim IE As Object
Dim I As Long
Dim strLInk As String

    Set IE = CreateObject("InternetExplorer.Application")

    'Starts loop
    For I = 2 To 3
        strLInk = "http://209.183.255.146/arcgis/rest/services/Solar/Buildings/MapServer/find?searchText=" & I - 1 & "&contains=false&searchFields=&sr=&layers=0&layerDefs=&returnGeometry=true&maxAllowableOffset=&geometryPrecision=&dynamicLayers=&returnZ=true&returnM=true&gdbVersion=&f=html"

        'Opens IE
        With IE
            .Visible = True
            .Navigate strLInk
            Do While IE.ReadyState <> 4
                DoEvents
            Loop

            'Moves data to worksheet
            Range("A" & I) = Split(Split(IE.document.body.outertext, "results")(1), "OBJECTID")(1)

        End With

    Next I

End Sub

By the way, VBA has it's own set of text functions, specifically it has InStr to find the position of a substring in a string, so you don't need to use Application.Find.

Also, there's Data>Text to Columns and Split.

You can use the latter with a delimiter of Chr(10) to split the data out into seperate lines and then use the former to split the data from field names.

Don't have time right now to post any code for that but I'll have another look tomorrow.