时间戳

首页 > 解决方案 > 如何更新此 VBA 代码以包含谷歌地图 API 密钥

excel - 如何更新此 VBA 代码以包含谷歌地图 API 密钥

问题描述

我是 VBA 新手，但我正在尝试更新计算两点之间距离的 Excel 电子表格。此代码曾经可以工作（据我所知），但现在需要 Google API 密钥。我准备好了我的 API 密钥，但不知道如何在这段代码中实现它。我可以使用一些指导。

（对不起，代码墙我不确定要包含什么，所以我复制/粘贴了所有内容）

Option Explicit

Function G_DISTANCE( _
    Origin As String, _
    Destination As String, _
    Optional Requery As Boolean = False _
    ) As Variant
' Requires a reference to Microsoft XML, v6.0

Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim distanceNode As IXMLDOMNode
Dim statusNode As IXMLDOMNode
Dim CachedFile As String
Dim NoCache As Boolean
    On Error GoTo exitRoute
    G_DISTANCE = CVErr(xlErrNA) ' Return an #N/A error in the case of any errors

    ' Check and clean inputs
    If WorksheetFunction.IsNumber(Origin) _
        Or IsEmpty(Origin) _
        Or Origin = "" Then GoTo exitRoute
    If WorksheetFunction.IsNumber(Destination) _
        Or IsEmpty(Destination) _
        Or Destination = "" Then GoTo exitRoute
    Origin = URLEncode(CStr(Origin), True)
    Destination = URLEncode(CStr(Destination), True)

    ' Check for existence of cached file
    CachedFile = Environ("temp") & "\" & Origin & "_" & Destination & "_Dist.xml"
    NoCache = (Len(Dir(CachedFile)) = 0)

    Set myRequest = New XMLHTTP60

    If NoCache Or Requery Then ' if no cached file exists then query Google
        ' Read the XML data from the Google Maps API
        myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
            & Origin & "&destination=" & Destination & "&sensor=false", False
        myRequest.send


    Else ' otherwise query the temp file
        myRequest.Open "GET", CachedFile
        myRequest.send
        Set myDomDoc = New DOMDocument60
        myDomDoc.LoadXML myRequest.responseText
        ' Get the status code of the cached XML file in case of previously cached errors
        Set statusNode = myDomDoc.SelectSingleNode("//status")
        If Not statusNode.Text = "OK" Then
            Call G_DISTANCE(Origin, Destination, True) ' Recursive way to try to remove cached errors
        End If
    End If

    ' Make the XML readable using XPath
    Set myDomDoc = New DOMDocument60
    myDomDoc.LoadXML myRequest.responseText

    ' If statusNode is "OK" then get the values to return
    Set statusNode = myDomDoc.SelectSingleNode("//status")
    If statusNode.Text = "OK" Then
        If NoCache Then: Call CreateFile(CachedFile, myRequest.responseText) ' Cache API response if required
        ' Get the distance
        Set distanceNode = myDomDoc.SelectSingleNode("//leg/distance/value")
        If Not distanceNode Is Nothing Then G_DISTANCE = val(distanceNode.Text) / 1000 ' Now works with comma as decimal separator
    Else
        G_DISTANCE = statusNode.Text
    End If
exitRoute:
    ' Tidy up
    Set statusNode = Nothing
    Set distanceNode = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing
End Function
```

```vba
Function G_DURATION( _
    Origin As String, _
    Destination As String, _
    Optional Requery As Boolean = False _
    ) As Variant
' Requires a reference to Microsoft XML, v6.0
' Dependencies:
' Encode_URL
' Utilities_Files.Create_File

' Updated 30/10/2012 to
'   - return an #N/A error if an error occurs
'   - cache if necessary
'   - check for and attempt to correct cached errors
'   - work on systems with comma as decimal separator

Dim myRequest As XMLHTTP60
Dim myDomDoc As DOMDocument60
Dim durationNode As IXMLDOMNode
Dim statusNode As IXMLDOMNode
Dim CachedFile As String
Dim NoCache As Boolean
    On Error GoTo exitRoute
    G_DURATION = CVErr(xlErrNA) ' Return an #N/A error in the case of any errors

    ' Check and clean inputs
    If WorksheetFunction.IsNumber(Origin) _
        Or IsEmpty(Origin) _
        Or Origin = "" Then GoTo exitRoute
    If WorksheetFunction.IsNumber(Destination) _
        Or IsEmpty(Destination) _
        Or Destination = "" Then GoTo exitRoute
    Origin = ConvertAccent(URLEncode(CStr(Origin), True))
    Destination = ConvertAccent(URLEncode(CStr(Destination), True))

    ' Check for existence of cached file
    CachedFile = Environ("temp") & "\" & Origin & "_" & Destination & "_Dist.xml"
    NoCache = (Len(Dir(CachedFile)) = 0)

    Set myRequest = New XMLHTTP60

    If NoCache Or Requery Then ' if no cached file exists then query Google
        ' Read the XML data from the Google Maps API
        myRequest.Open "GET", "http://maps.googleapis.com/maps/api/directions/xml?origin=" _
            & Origin & "&destination=" & Destination & "&sensor=false", False
        myRequest.send
    Else ' otherwise query the temp file
        myRequest.Open "GET", CachedFile
        myRequest.send
        Set myDomDoc = New DOMDocument60
        myDomDoc.LoadXML myRequest.responseText
        ' Get the status code of the cached XML file in case of previously cached errors
        Set statusNode = myDomDoc.SelectSingleNode("//status")
        If Not statusNode.Text = "OK" Then
            Call G_DURATION(Origin, Destination, True) ' Recursive way to try to remove cached errors
        End If
    End If

    ' Make the XML readable using XPath
    Set myDomDoc = New DOMDocument60
    myDomDoc.LoadXML myRequest.responseText

    ' If statusNode is "OK" then get the values to return
    Set statusNode = myDomDoc.SelectSingleNode("//status")
    If statusNode.Text = "OK" Then
        If NoCache Then: Call CreateFile(CachedFile, myRequest.responseText) ' Cache API response if required
        ' Get the duration
        Set durationNode = myDomDoc.SelectSingleNode("//leg/duration/value")
        If Not durationNode Is Nothing Then G_DURATION = val(durationNode.Text) / 60 ' Now works with comma as decimal separator
    End If

exitRoute:
    ' Tidy up
    Set statusNode = Nothing
    Set durationNode = Nothing
    Set myDomDoc = Nothing
    Set myRequest = Nothing
End Function

标签： excelvbaapigoogle-maps

解决方案

您需要将 API 密钥添加到keyDirections API 请求中的参数。另请注意，该sensor参数已弃用。因此，您可以在这里轻松地用密钥替换它。作为附加说明，如果可能，应始终通过 HTTPS 进行调用。

见下文：

If NoCache Or Requery Then ' if no cached file exists then query Google
    ' Read the XML data from the Google Maps API
    myRequest.Open "GET", "https://maps.googleapis.com/maps/api/directions/xml?origin=" _
        & Origin & "&destination=" & Destination & "&key=AIza...", False
    myRequest.send
Else ' otherwise query the temp file

其中“AIza...”应该是您自己项目的 API 密钥（我建议您将其添加为先前定义的变量）。请查看Google 的文档供您参考。

确保在您的项目上启用了 Billing 和 Directions API。

希望这可以帮助！

推荐阅读