Google 地点 API(附近搜索)未返回结果

Question

我正在从Excel调用此VBA函数，该函数使用Google Places API附近搜索功能并且不返回结果。 我知道有结果，因为此 HTTP 调用返回相同输入参数的结果。 你知道为什么函数不返回结果吗？

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

Answer 1

您的问题无法正确/完整地呈现您的代码，但在顶部的链接中，您在"radius"之前有一个空格。如果我将整个内容粘贴到地址栏中，则会收到"无效请求"。如果我删除空间，它可以工作。

Answer 2

代码中有一堆错误，导致宏过早退出。

使用错误处理程序绝不是一个好主意，除非您确切知道将返回哪些错误。

• 调试的第一步应该是禁用错误处理程序。
  • 如果这样做，您将看到这些语句都是非法的，因为Object 不支持该方法。 您需要显式返回 text 属性。

'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

• 然后，您需要比较您发送的字符串与要发送的字符串。 这样做后，您会看到您生成的字符串包含字符串纬度，而不是名为latitude的变量的值。
  • 因此，您需要从生成的字符串周围删除引号。

例如：

'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

• 最后，您已将Radius声明为类型Integer。 在 VBA 中，整数限制为 32,767;半径的允许值最大为 50,000。 因此，您应该将其声明为类型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

进行这些更改后，代码应按设计运行。

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

注意：您的错误处理程序甚至可能不是必需的。我相信(不是 100% 确定(在 VBA 中，您在此代码中创建的对象将在宏终止时释放，无论是正常还是异常。并非所有对象都是如此，但应该适用于xml对象。 请参阅何时应终止 Excel VBA 变量或将其设置为"无"？

对于 URL 字符串，代码会生成字符串：

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

请注意，您发送的是字符串"纬度"，而不是实际的纬度值。

以下是您的代码，其中包含所做的更正和注释：

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