如何在VBA中添加谷歌API密钥

Question

我有一个excel文件，我正在尝试使用Google Maps API构建它，以便我可以分辨地址之间的距离。由于限制，我一次只能运行几行。我确实有一个 API 密钥，但无法弄清楚在哪里应用密钥。这是我正在从一些在线开源编辑的代码。如果我一次执行一条，则代码有效，但是对于数百条记录，我需要复制和粘贴大量行。所以我有一个谷歌的许可证密钥。有人可以帮助我了解在哪里应用密钥吗？

提前谢谢你。

Const strUnits = "imperial" ' imperial/metric (miles/km)
Function CleanHTML(ByVal strHTML)
'Helper function to clean HTML instructions
Dim strInstrArr1() As String
Dim strInstrArr2() As String
Dim s As Integer
strInstrArr1 = Split(strHTML, "<")
For s = LBound(strInstrArr1) To UBound(strInstrArr1)
strInstrArr2 = Split(strInstrArr1(s), ">")
If UBound(strInstrArr2) > 0 Then
strInstrArr1(s) = strInstrArr2(1)
Else
strInstrArr1(s) = strInstrArr2(0)
End If
Next
CleanHTML = Join(strInstrArr1)
End Function
Public Function formatGoogleTime(ByVal lngSeconds As Double)
'Helper function. Google returns the time in seconds, so this converts it into time format hh:mm
Dim lngMinutes As Long
Dim lngHours As Long
lngMinutes = Fix(lngSeconds / 60)
lngHours = Fix(lngMinutes / 60)
lngMinutes = lngMinutes - (lngHours * 60)
formatGoogleTime = Format(lngHours, "00") & ":" & Format(lngMinutes, "00")
End Function


Function gglDirectionsResponse(ByVal strStartLocation, ByVal strEndLocation, ByRef strTravelTime, ByRef strDistance, ByRef strInstructions, Optional ByRef strError = "") As Boolean
On Error GoTo errorHandler
' Helper function to request and process XML generated by Google Maps.
Dim strURL As String
Dim objXMLHttp As Object
Dim objDOMDocument As Object
Dim nodeRoute As Object
Dim lngDistance As Long
Set objXMLHttp = CreateObject("MSXML2.XMLHTTP")
Set objDOMDocument = CreateObject("MSXML2.DOMDocument.6.0")
strStartLocation = Replace(strStartLocation, " ", "+")
strEndLocation = Replace(strEndLocation, " ", "+")
strURL = "http://maps.googleapis.com/maps/api/directions/xml" & _
"?origin=" & strStartLocation & _
"&destination=" & strEndLocation & _
"&sensor=false" & _
"&units=" & strUnits   'Sensor field is required by google and indicates whether a Geo-sensor is being used by the device making the request
'Send XML request
With objXMLHttp
.Open "GET", strURL, False
.setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
.Send
objDOMDocument.LoadXML .ResponseText
End With
With objDOMDocument
If .SelectSingleNode("//status").Text = "OK" Then
'Get Distance
lngDistance = .SelectSingleNode("/DirectionsResponse/route/leg/distance/value").Text ' Retrieves distance in meters
Select Case strUnits
Case "imperial": strDistance = Round(lngDistance * 0.00062137, 1)  'Convert meters to miles
Case "metric": strDistance = Round(lngDistance / 1000, 1) 'Convert meters to miles
End Select
'Get Travel Time
strTravelTime = .SelectSingleNode("/DirectionsResponse/route/leg/duration/value").Text  'returns in seconds from google
strTravelTime = formatGoogleTime(strTravelTime) 'converts seconds to hh:mm
'Get Directions
For Each nodeRoute In .SelectSingleNode("//route/leg").ChildNodes
If nodeRoute.BaseName = "step" Then
strInstructions = strInstructions & nodeRoute.SelectSingleNode("html_instructions").Text & " - " & nodeRoute.SelectSingleNode("distance/text").Text & vbCrLf
End If
Next
strInstructions = CleanHTML(strInstructions) 'Removes MetaTag information from HTML result to convert to plain text.
Else
strError = .SelectSingleNode("//status").Text
GoTo errorHandler
End If
End With
gglDirectionsResponse = True
GoTo CleanExit

If strError = "" Then strError = Err.Description
strDistance = -1
strTravelTime = "00:00"
strInstructions = ""
gglDirectionsResponse = False
Set objDOMDocument = Nothing
Set objXMLHttp = Nothing
End Function

Function getGoogleTravelTime(ByVal strFrom, ByVal strTo) As String
'Returns the journey time between strFrom and strTo
Dim strTravelTime As String
Dim strDistance As String
Dim strInstructions As String
Dim strError As String
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
getGoogleTravelTime = strTravelTime
Else
getGoogleTravelTime = strError
End If
End Function
Function getGoogleDistance(ByVal strFrom, ByVal strTo) As String
'Returns the distance between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
getGoogleDistance = strDistance
Else
getGoogleDistance = strError
End If
End Function
Function getGoogleDirections(ByVal strFrom, ByVal strTo) As String
'Returns the directions between strFrom and strTo
'where strFrom/To are address search terms recognisable by Google
'i.e. Postcode, address etc.
Dim strTravelTime As String
Dim strDistance As String
Dim strError As String
Dim strInstructions As String
If gglDirectionsResponse(strFrom, strTo, strTravelTime, strDistance, strInstructions, strError) Then
getGoogleDirections = strInstructions
Else
getGoogleDirections = strError
End If
End Function

Answer 1

我今天刚从谷歌拿到了我的API密钥。

我不得不玩弄代码，但我使用的是您在上面的代码示例中使用的完全相同的例程。

应该注意的是，您必须使用 SSL 发送请求。 https 不是以下字符串中的 http：

strURL = "https://maps.googleapis.com/maps/api/directions/xml" & _
"?origin=" & strStartLocation & _
"&destination=" & strEndLocation & _
"&sensor=false" & _
"&units=" & strUnits

这是我放置 API 密钥的地方，现在我的应用程序的工作方式就像我需要密钥之前一样。

希望这能解决您的问题。

====

=====================================================

APIKey = "Your API Key Here!"
'Send XML request
With objXMLHttp
.Open "GET", strURL & "&key=" & APIKey, False
.setRequestHeader "Content-Type", "application/x-www-form-URLEncoded"
.send
objDOMDocument.LoadXML .responseText
End With