How to get Google Places API (nearby search) data to Excel VBA - vba

Question

I have Excel sheet with a lot of addresses (and the matching coordinates). I want to use Google Places API to create a function that gets me e. g. all restaurants surrounding a specific address. I try to output the names of all matching restaurants, the issue is that the output is just "0".
Here is my code:
Function Nearby(Lat As Long, Lng As Long) As Variant
'Variablen definieren
Dim Request As New XMLHTTP30
Dim Results As New DOMDocument30
Dim StatusNode As IXMLDOMNode
Dim NearbyNode As IXMLDOMNode
On Error GoTo errorHandler
Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=" & Lat & "," & Lng & "&radius=50&type=restaurant&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU"""
Request.send
Results.LoadXML Request.responseText
Set StatusNode = Results.SelectSingleNode("//status")
Select Case UCase(StatusNode.Text)
Case "OK"
Set NearbyNode = Results.SelectSingleNode("//result/name[1]/name[2]/name[3]/name[4]")
Nearby = NearbyNode.Text
Case "ZERO_RESULTS"
Nearby = "The address does not exists"
Case Else
Nearby = "Error"
End Select
errorHandler:
Set StatusNode = Nothing
Set NearbyNode = Nothing
Set Results = Nothing
Set Request = Nothing
End Function

Answer 1

I slightly reworked your code, try the below example:
Option Explicit
Sub TestNearby()
Dim NearbyNames
Dim NearbyState As String
Nearby "-33.8670522", "151.1957362", "1000", "hospital", NearbyNames, NearbyState
If NearbyState = "OK" Then
MsgBox Join(NearbyNames, vbCrLf)
Else
MsgBox NearbyState
End If
End Sub
Sub Nearby(Lat As String, Lng As String, Dist As String, PointType As String, Names As Variant, State As String)
Dim Request As Object
Dim Results As Object
Dim Node
On Error GoTo errorHandler
Set Request = CreateObject("MSXML2.XMLHTTP")
Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?" & _
"location=" & Lat & "," & Lng & _
"&radius=" & Dist & _
"&type=" & PointType & _
"&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU", False
Request.send
Set Results = Request.responseXML
Select Case UCase(Results.SelectSingleNode("//status").Text)
Case "OK"
With CreateObject("Scripting.Dictionary")
For Each Node In Results.SelectNodes("//PlaceSearchResponse/result/name")
.Add .Count, Node.nodeTypedValue
Next
Names = .Items()
End With
State = "OK"
Case "ZERO_RESULTS"
State = "No results"
Case Else
State = "Wrong request"
End Select
Exit Sub
errorHandler:
State = "Error"
End Sub
The output for me is:

Answer 2

I changed Lat,Lng to type double and modified the Request.Open "GET" string
Sub Nearby()
Dim Request As New XMLHTTP30
Dim Results As New DOMDocument30
Dim StatusNode As IXMLDOMNode
Dim NearbyNode As IXMLDOMNode
Dim Node As IXMLDOMNode
On Error GoTo errorHandler
Dim Lat As Double 'Chicago
Lat = 41.878114
Dim Lng As Double
Lng = -87.629798
Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=" & Lat & "," & Lng & "&radius=50&type=restaurant&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU" & "&sensor=False"
Request.send
Results.LoadXML Request.responseText
Set StatusNode = Results.SelectSingleNode("//status")
Select Case UCase(StatusNode.Text)
Case "OK"
For Each Node In Results.SelectNodes("//PlaceSearchResponse/result/name")
Debug.Print Node.nodeTypedValue
Next
Case "ZERO_RESULTS"
Debug.Print "The address does not exists"
Case Else
Debug.Print "Error"
End Select
errorHandler:
Set StatusNode = Nothing
Set NearbyNode = Nothing
Set Results = Nothing
Set Request = Nothing
End Sub

Answer 3

This function returns a string of comma separated values (albeit needs more error trapping) :
Public Function NearBy(Lat As Double, Lng As Double) As Variant
Dim Request As New XMLHTTP30
Dim Results As New DOMDocument30
Dim StatusNode As IXMLDOMNode
Dim NearbyNode As IXMLDOMNode
Dim Node As IXMLDOMNode
Dim sz As String
On Error GoTo errorHandler
Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=" & Lat & "," & Lng & "&radius=150&type=restaurant&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU" & "&sensor=False"
Request.send
Results.LoadXML Request.responseText
Set StatusNode = Results.SelectSingleNode("//status")
Select Case UCase(StatusNode.Text)
Case "OK"
For Each Node In Results.SelectNodes("//PlaceSearchResponse/result/name")
sz = sz & Node.nodeTypedValue & ", "
Next
NearBy = Left(sz, Len(sz) - 2) 'remove last ", "
Case "ZERO_RESULTS"
NearBy = "The address does not exists"
Case Else
NearBy = "Error"
End Select
errorHandler:
Set StatusNode = Nothing
Set NearbyNode = Nothing
Set Results = Nothing
Set Request = Nothing
End Function