help with web api call in excel

jwprosser

New Member
Joined
Nov 20, 2013
Messages
6
I have a spread sheet that has Lat and long in 2 separate columns, several hundred rows.

I need to submit that lat/long from each row to a web api that will return the county, state and Fips number. The web api returns the data in xml. I need to write that data to the next 3 columns on the same row.

The web api is pretty simple, http://data.fcc.gov/api/block/2010/find?latitude=40.0&longitude=-85
and returns the following
<Response status="OK" executionTime="10"><Block FIPS="181770103002004"/><County FIPS="18177" name="Wayne"/><State FIPS="18" code="IN" name="Indiana"/></Response>

Your help is appricated, I am new to web services and api. This can be in vba, .net or vb.

Thanks
John
 

Excel Facts

Convert text numbers to real numbers
Select a column containing text numbers. Press Alt+D E F to quickly convert text to numbers. Faster than "Convert to Number"
Here one approach:

Instructions:

Start with an empty file

Put a few latitude, longitude pairs in columns A and B

Sheet1

*ABCDE
140122***
23355***
34080***
41222***
52266***

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4


Copy this code to a module (Alt F11, Insert, Module and Paste)


Code:
Function getInfo(Latitude, Longitude) As Variant

   [B] ' "MSXML2.ServerXMLHTTP" requires [U]Microsoft XML in [B]References[/B][/U][/B]

    Dim objhttp: Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")
    Dim URL: URL = "http://data.fcc.gov/api/block/2010/find?latitude=" & Latitude & _
                            "&longitude=-" & Longitude & ""
    objhttp.Open "GET", URL, False
    objhttp.send ("")
    Dim arr: arr = Split(objhttp.responsetext, Chr(34))
    If UBound(arr) < 23 Then
        getInfo = Array("#N/A", "#N/A", "#N/A")
    Else
        getInfo = Array(arr(13), arr(17), arr(23))
    End If
    Set objhttp = Nothing
End Function
Sub GetAll()
    With ActiveSheet
        Dim info, cel
        Dim rng: Set rng = Application.Intersect(.Columns("A"), .UsedRange)
        For Each cel In rng.Cells
            info = getInfo(cel, cel.Offset(0, 1))
            cel.Offset(0, 2) = info(0)
            cel.Offset(0, 3) = info(1)
            cel.Offset(0, 4) = info(2)
        Next
    End With
End Sub

Make sure that Microsoft XMLis in References(Tools, References)

Save the file


Run GetAll

Note results:

Sheet1

*ABCDE
140122061030009003078TehamaCalifornia
23355#N/A#N/A#N/A
34080421257957002024WashingtonPennsylvania
41222#N/A#N/A#N/A
52266#N/A#N/A#N/A

<tbody>
</tbody>


Excel tables to the web >> Excel Jeanie HTML 4


Let me know how it works....

 
Upvote 0
Tlowry,
Thanks this worked very well. I took me a little bit to figure 2 issues that were nothing big. I have included the modified code. The first issue was in the string for latitude for the site, you had included the "-" sign in the statement and my data already had that, the other was I went ahead and added the parts to capture the rest of the data. I am now testing it, so far it takes about 30 sec to process 250 records.

Function getInfo(Latitude, Longitude) As Variant

' "MSXML2.ServerXMLHTTP" requires Microsoft XML in References

Dim objhttp: Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")
Dim URL: URL = "http://data.fcc.gov/api/block/2010/find?latitude=" & Latitude & _
"&longitude=" & Longitude & ""
objhttp.Open "GET", URL, False
objhttp.send ("")
Dim arr: arr = Split(objhttp.responseText, Chr(34))
If UBound(arr) < 23 Then
getInfo = Array("#N/A", "#N/A", "#N/A", "#N/A", "#N/A", "#N/A")
Else
getInfo = Array(arr(13), arr(15), arr(17), arr(19), arr(21), arr(23))
End If
Set objhttp = Nothing
End Function
Sub GetAll()
With ActiveSheet
Dim info, cel
Dim rng: Set rng = Application.Intersect(.Columns("A"), .UsedRange)
For Each cel In rng.Cells
info = getInfo(cel, cel.Offset(0, 1))
cel.Offset(0, 2) = info(0)
cel.Offset(0, 3) = info(1)
cel.Offset(0, 4) = info(2)
cel.Offset(0, 5) = info(3)
cel.Offset(0, 6) = info(4)
cel.Offset(0, 7) = info(5)
Next
End With
End Sub

Thanks,
JP
 
Upvote 0
More nerdly approach:

Code:
Sub GetAll()
    Dim cel
    For Each cel In Application.Intersect(Columns("A"), ActiveSheet.UsedRange).Cells
        Range(cel.Offset(0, 2).Address, cel.Offset(0, 6).Address) = _
                ReadStateXML(cel, cel.Offset(0, 1))
    Next
End Sub
Function ReadStateXML(Latitude, Longitude) As Variant
    Dim arrReturn(0 To 5)
    Dim xmlDom As MSXML2.DOMDocument
    Dim objhttp: Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")
    Dim URL: URL = "http://data.fcc.gov/api/block/2010/find?latitude=" & Latitude & _
                            "&longitude=-" & Longitude & ""
    objhttp.Open "GET", URL, False
    objhttp.send ("")
    Set xmlDom = New MSXML2.DOMDocument
    '   Debug.Print objhttp.responseText
    With xmlDom
        .Load objhttp.responseXML
        Dim itm, ele
        For Each itm In .getElementsByTagName("Block")
            arrReturn(0) = itm.getAttribute("FIPS")
        Next
        For Each itm In .getElementsByTagName("County")
            arrReturn(1) = itm.getAttribute("FIPS")
            arrReturn(2) = itm.getAttribute("name")
        Next
        For Each itm In .getElementsByTagName("State")
            arrReturn(3) = itm.getAttribute("FIPS")
            arrReturn(4) = itm.getAttribute("code")
            arrReturn(5) = itm.getAttribute("name")
        Next
    End With
    ReadStateXML = arrReturn
End Function
 
Upvote 0
Re: help with web api call in excel (Update)

Has anyone updated this code now that they have modified their website? I cant seem to get this to work by just replacing it. Any help would be appreciated.






More nerdly approach:

Code:
Sub GetAll()
    Dim cel
    For Each cel In Application.Intersect(Columns("A"), ActiveSheet.UsedRange).Cells
        Range(cel.Offset(0, 2).Address, cel.Offset(0, 6).Address) = _
                ReadStateXML(cel, cel.Offset(0, 1))
    Next
End Sub
Function ReadStateXML(Latitude, Longitude) As Variant
    Dim arrReturn(0 To 5)
    Dim xmlDom As MSXML2.DOMDocument
    Dim objhttp: Set objhttp = CreateObject("MSXML2.ServerXMLHTTP")
    Dim URL: URL = "http://data.fcc.gov/api/block/2010/find?latitude=" & Latitude & _
                            "&longitude=-" & Longitude & ""
    objhttp.Open "GET", URL, False
    objhttp.send ("")
    Set xmlDom = New MSXML2.DOMDocument
    '   Debug.Print objhttp.responseText
    With xmlDom
        .Load objhttp.responseXML
        Dim itm, ele
        For Each itm In .getElementsByTagName("Block")
            arrReturn(0) = itm.getAttribute("FIPS")
        Next
        For Each itm In .getElementsByTagName("County")
            arrReturn(1) = itm.getAttribute("FIPS")
            arrReturn(2) = itm.getAttribute("name")
        Next
        For Each itm In .getElementsByTagName("State")
            arrReturn(3) = itm.getAttribute("FIPS")
            arrReturn(4) = itm.getAttribute("code")
            arrReturn(5) = itm.getAttribute("name")
        Next
    End With
    ReadStateXML = arrReturn
End Function
 
Upvote 0

Forum statistics

Threads
1,213,544
Messages
6,114,249
Members
448,556
Latest member
peterhess2002

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