1

I am calling this VBA function from Excel which uses the Google Places API Nearby Search function and is not returning results. I know there are results since this HTTP call returns results for the same input parameters. Do you know why the function is not returning results?

https://maps.googleapis.com/maps/api/place/nearbysearch/json?location=45.5662453,-122.6628821&radius=1500&type=park&key=AIzaSyCbBAbRZG0yhCHjJLaKjv8ARp2J6pv1wSQ
Public Function GetNearbyPark(latitude As Double, longitude As Double, Radius As Integer) As String

'-----------------------------------------------------------------------------------------------------
'This function returns the park name for a given latitude and longitude and radius using the Google
'Places Nearby Search API.
'Radius is in meters
'-----------------------------------------------------------------------------------------------------

'Declaring the necessary variables.
Dim apiKey                   As String
Dim xmlhttpRequest           As Object
Dim xmlDoc                   As Object
Dim xmlStatusNode            As Object
Dim xmlNearbyParkNameNode    As Object
Dim xmlNearbyParkAddressNode As Object
   
'Set your API key in this variable.
'Here is the ONLY place in the code where you have to put your API key.
apiKey = "AIzaSyCbBAbRZG0yhCHjJLaKjv8ARp2J6pv1wSQ"

'Check that an API key has been provided.
If apiKey = vbNullString Or apiKey = "The API Key" Then
    GetNearbyPark = "Empty or invalid API Key"
    Exit Function
End If

'Generic error handling.
On Error GoTo errorHandler
        
'Create the request object and check if it was created successfully.
Set xmlhttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
If xmlhttpRequest Is Nothing Then
    GetNearbyPark = "Cannot create the request object"
    Exit Function
End If
    
'Create the request based on Google Places API. Parameters (from Google page):
'- Longitude
'- Latitude
'- Radius

'xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _
'& "&address=" & Application.EncodeURL(address) & "&key=" & apiKey, False

Debug.Print "At API call"

xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?" & "location=" & "latitude" & "," & longitude & "&radius=" & Radius & "&type=park&key=" & apiKey, False

'Send the request to the Google server.
xmlhttpRequest.send

'Create the DOM document object and check if it was created successfully.
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
If xmlDoc Is Nothing Then
    GetNearbyPark = "Cannot create the DOM document object"
    Exit Function
End If

'Read the XML results from the request.
xmlDoc.LoadXML xmlhttpRequest.responseText

'Get the value from the status node.
Set xmlStatusNode = xmlDoc.SelectSingleNode("//status")

Debug.Print xmlStatusNode

'Based on the status node result, proceed accordingly.
Select Case UCase(xmlStatusNode.Text)

    Case "OK"                       'The API request was successful.
                                    'At least one result was returned.
        
        'Get the park name and address node values of the first result.
        Set xmlNearbyParkNameNode = xmlDoc.SelectSingleNode("//result/name")
        'Set xmlNearbyParkAddressNode = xmlDoc.SelectSingleNode("//result/vicinity")
        
        Debug.Print xmlNearbyParkNameNode
        
        'Return the park name and address as text
         'GetNearbyPark = xmlNearbyParkNameNode.Text & ", " & xmlNearbyParkAddressNode.Text
         GetNearbyPark = xmlNearbyParkNameNode.Text
    
    Case "ZERO_RESULTS"             'The geocode was successful but returned no results.
        GetNearbyPark = "No park exists within the radius of the defined coordinates"
        
    Case "OVER_DAILY_LIMIT"         'Indicates any of the following:
                                    '- The API key is missing or invalid.
                                    '- Billing has not been enabled on your account.
                                    '- A self-imposed usage cap has been exceeded.
                                    '- The provided method of payment is no longer valid
                                    '  (for example, a credit card has expired).
        GetNearbyPark = "Billing or payment problem"
        
    Case "OVER_QUERY_LIMIT"         'The requestor has exceeded the quota limit.
        GetNearbyPark = "Quota limit exceeded"
        
    Case "REQUEST_DENIED"           'The API did not complete the request.
        GetNearbyPark = "Server denied the request"
        
    Case "INVALID_REQUEST"           'The API request is empty or is malformed.
        GetNearbyPark = "Request was empty or malformed"
    
    Case "UNKNOWN_ERROR"            'The request could not be processed due to a server error.
        GetNearbyPark = "Unknown error"
    
    Case Else   'Just in case...
        GetNearbyPark = "Error"
    
End Select
    
'Release the objects before exiting (or in case of error).
errorHandler:
    Set xmlStatusNode = Nothing
    Set xmlNearbyParkNameNode = Nothing
    Set xmlNearbyParkAddressNode = Nothing
    Set xmlDoc = Nothing
    Set xmlhttpRequest = Nothing

End Function
braX
  • 11,506
  • 5
  • 20
  • 33
Gary Beckler
  • 41
  • 1
  • 8

2 Answers2

0

Your question does not render your code properly/completely, but in your link at the top, you have a space before "radius". If I paste the whole thing into the address bar, I get "invalid request". If I remove the space, it works.

Excelosaurus
  • 2,789
  • 1
  • 14
  • 20
0

You have a bunch of errors in your code which are causing your macro to exit prematurely.

It is NEVER a good idea to use the error handler unless you know EXACTLY what errors will be returned.

  • Your first step in debugging should be to disable the error handler.
    • had you done that, you would have seen that these statements are both illegal as the Object does not support that method. You need to explicitly return the text property.
'Object does not support this method
'Debug.Print xmlStatusNode
Debug.Print xmlStatusNode.Text

...

'Object does not support this method
'Debug.Print xmlNearbyParkNameNode
Debug.Print xmlNearbyParkNameNode.Text
  • Then, you need to compare the string you send vs the string you want to send. Had you done that, you see that the string you are generating includes the string latitude and not the value of the variable named latitude.
    • so you need to remove the quotation marks from around the generated string.

eg:

    'Remove quote marks from around "latitude" so as to send the variable and not the string
xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?" & "location=" & latitude & "," & longitude & "&radius=" & Radius & "&type=park&key=" & apiKey, False
  • Finally, you have declared Radius as being of type Integer. In VBA, Integers are limited to 32,767; and the allowable values for Radius are up to 50,000. So you should declare it as being of type Long.
'Since maximum radius is 50,000 must use Long data type
Public Function GetNearbyPark(latitude As Double, longitude As Double, Radius As Long) As String

Once you make these changes, your code should run as designed.

=GetNearbyPark(45.5662453,-122.6628821,1500) --> Peninsula Park Rose Garden

Note Your error handler may not even be necessary. I believe (not 100% certain) that in VBA the objects you have created in this code will be released when then macro terminates, whether normally or abnormally. This may not be the case for all objects, but should be for your xml objects. See When should an Excel VBA variable be killed or set to Nothing?

With regard to your URL string, your code generates the string:

https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=latitude,-122.6628821&radius=1500&type=park&key=AIzaSyCbBAbRZG0yhCHjJLaKjv8ARp2J6pv1wSQ

Note that you are sending the string "latitude" and not the actual latitude value.

Here is your code with the corrections made and annotated:

Option Explicit

'Since maximum radius is 50,000 must use Long data type
Public Function GetNearbyPark(latitude As Double, longitude As Double, Radius As Long) As String

'-----------------------------------------------------------------------------------------------------
'This function returns the park name for a given latitude and longitude and radius using the Google
'Places Nearby Search API.
'Radius is in meters
'-----------------------------------------------------------------------------------------------------

'Declaring the necessary variables.
Dim apiKey                   As String
Dim xmlhttpRequest           As Object
Dim xmlDoc                   As Object
Dim xmlStatusNode            As Object
Dim xmlNearbyParkNameNode    As Object
Dim xmlNearbyParkAddressNode As Object
   
'Set your API key in this variable.
'Here is the ONLY place in the code where you have to put your API key.
apiKey = "AIzaSyCbBAbRZG0yhCHjJLaKjv8ARp2J6pv1wSQ"

'Check that an API key has been provided.
If apiKey = vbNullString Or apiKey = "The API Key" Then
    GetNearbyPark = "Empty or invalid API Key"
    Exit Function
End If

'Generic error handling.
'Probably no need for this
'On Error GoTo errorHandler
        
'Create the request object and check if it was created successfully.
Set xmlhttpRequest = CreateObject("MSXML2.ServerXMLHTTP")
If xmlhttpRequest Is Nothing Then
    GetNearbyPark = "Cannot create the request object"
    Exit Function
End If
    
'Create the request based on Google Places API. Parameters (from Google page):
'- Longitude
'- Latitude
'- Radius

'xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?" _
'& "&address=" & Application.EncodeURL(address) & "&key=" & apiKey, False

Debug.Print "At API call"

'Remove quote marks from around "latitude" so as to send the variable and not the string
xmlhttpRequest.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?" & "location=" & latitude & "," & longitude & "&radius=" & Radius & "&type=park&key=" & apiKey, False

'Send the request to the Google server.
xmlhttpRequest.send

'Create the DOM document object and check if it was created successfully.
Set xmlDoc = CreateObject("MSXML2.DOMDocument")
If xmlDoc Is Nothing Then
    GetNearbyPark = "Cannot create the DOM document object"
    Exit Function
End If

'Read the XML results from the request.
xmlDoc.LoadXML xmlhttpRequest.responseText

'Get the value from the status node.
Set xmlStatusNode = xmlDoc.SelectSingleNode("//status")

'Object does not support this method
'Debug.Print xmlStatusNode
Debug.Print xmlStatusNode.Text


'Based on the status node result, proceed accordingly.
Select Case UCase(xmlStatusNode.Text)

    Case "OK"                       'The API request was successful.
                                    'At least one result was returned.
        
        'Get the park name and address node values of the first result.
        Set xmlNearbyParkNameNode = xmlDoc.SelectSingleNode("//result/name")
        'Set xmlNearbyParkAddressNode = xmlDoc.SelectSingleNode("//result/vicinity")
        
        'Object does not support this method
        'Debug.Print xmlNearbyParkNameNode
        Debug.Print xmlNearbyParkNameNode.Text
        
        'Return the park name and address as text
         'GetNearbyPark = xmlNearbyParkNameNode.Text & ", " & xmlNearbyParkAddressNode.Text
         GetNearbyPark = xmlNearbyParkNameNode.Text
    
    Case "ZERO_RESULTS"             'The geocode was successful but returned no results.
        GetNearbyPark = "No park exists within the radius of the defined coordinates"
        
    Case "OVER_DAILY_LIMIT"         'Indicates any of the following:
                                    '- The API key is missing or invalid.
                                    '- Billing has not been enabled on your account.
                                    '- A self-imposed usage cap has been exceeded.
                                    '- The provided method of payment is no longer valid
                                    '  (for example, a credit card has expired).
        GetNearbyPark = "Billing or payment problem"
        
    Case "OVER_QUERY_LIMIT"         'The requestor has exceeded the quota limit.
        GetNearbyPark = "Quota limit exceeded"
        
    Case "REQUEST_DENIED"           'The API did not complete the request.
        GetNearbyPark = "Server denied the request"
        
    Case "INVALID_REQUEST"           'The API request is empty or is malformed.
        GetNearbyPark = "Request was empty or malformed"
    
    Case "UNKNOWN_ERROR"            'The request could not be processed due to a server error.
        GetNearbyPark = "Unknown error"
    
    Case Else   'Just in case...
        GetNearbyPark = "Error"
    
End Select
    
'Release the objects before exiting (or in case of error).
errorHandler:
    Set xmlStatusNode = Nothing
    Set xmlNearbyParkNameNode = Nothing
    Set xmlNearbyParkAddressNode = Nothing
    Set xmlDoc = Nothing
    Set xmlhttpRequest = Nothing

End Function
Ron Rosenfeld
  • 53,870
  • 7
  • 28
  • 60
  • Thank you Ron for your help. I made these changes and am still not receiving results. I do not see where the generated string for latitude is within quotation marks. The updated code is below. Could you add your corrections and paste the corrected code that returns the result you received earlier? – Gary Beckler Jul 05 '20 at 18:20
  • @GaryBeckler I just copy/pasted functioning code, with annotations where I made the changes. And also a copy/paste of the bad URL your code was generating. With the API you showed the code returns `REQUEST DENIED`, but it works with a valid API. – Ron Rosenfeld Jul 05 '20 at 21:25
  • This is now working. I had to change the "HTTP Referrers" application restriction to "IP Addresses" in the API Key credentials in Google Cloud Console to get this to work. Thanks Ron for your help – Gary Beckler Jul 06 '20 at 03:09