我想在地址解析宏中插入API密钥

Question

这是已经存在的代码。现在，我需要在程序中插入API密钥并使其正常工作。我应该在哪里以及如何插入API密钥？

Sub Geocode()
'
Dim counter1 As Long
Dim Address As String
Dim Longitude As Double
Dim Latitude As Double
Dim Success As Boolean
Dim Status As String
counter1 = 2
Do While Not IsEmpty(Cells(counter1, 1))
    Cells(counter1, 5) = Cells(counter1, 1) & ", " & Cells(counter1, 2) & ", " & Cells(counter1, 3) & ", " & Cells(counter1, 4)
    Address = Cells(counter1, 5)
    Success = GetLongitudeAndLatitude(Address, Longitude, Latitude, Status)
            If Success = True Then
                Cells(counter1, 7) = Longitude
                Cells(counter1, 6) = Latitude
            Else
                Cells(counter1, 6) = Status
                Cells(counter1, 7) = Status
            End If
    counter1 = counter1 + 1
    Application.Wait (Now + TimeValue("00:00:01"))
Loop

Columns("E:E").Select
Selection.ClearContents

End Sub





Private Function GetLongitudeAndLatitude(Address As String, Longitude As Double, Latitude As Double, Status As String) As Boolean

    ' Declare variables and set return value to false by default
    GetLongitudeAndLatitude = False
    Dim response As DOMDocument60
    Dim http As XMLHTTP60
    Dim node As IXMLDOMNode
    Dim nodes As IXMLDOMNodeList
    Set http = New XMLHTTP60

    ' Read the data from the website
    On Error Resume Next
    ' Open an XML request from Google using their GeoCode API
    http.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?address=" & URLEncode(Address), False
    http.send
    Set response = http.responseXML

    ' get the status node.  This node tells you whether your search succeeded - OK means success.  Any other status means some kind of error or address not found.
    Set node = response.SelectSingleNode("/GeocodeResponse/status")
    If node.nodeTypedValue <> "OK" Then
        Status = node.nodeTypeString
    Else
        Set nodes = response.SelectNodes("/GeocodeResponse/result")
        ' check for multiple addresses if we found more than 1 result then error out.
        If nodes.Length > 1 Then
            MsgBox ("Found Multiple Matches for Address: " & Address)
        Else
            ' grab the latitude and longitude from the XML response
            Set node = response.SelectSingleNode("/GeocodeResponse/result/geometry/location/lat")
            Latitude = node.nodeTypedValue
            Set node = response.SelectSingleNode("/GeocodeResponse/result/geometry/location/lng")
            Longitude = node.nodeTypedValue
            GetLongitudeAndLatitude = True
        End If

    End If

    Set http = Nothing
    Set response = Nothing

End Function

' URL Encoding function courtesy of http://stackoverflow.com/questions/218181/how-can-i-url-encode-a-string-in-excel-vba
Private Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String

  Dim StringLen As Long: StringLen = Len(StringVal)

  If StringLen > 0 Then
    ReDim result(StringLen) As String
    Dim i As Long, CharCode As Integer
    Dim Char As String, Space As String

    If SpaceAsPlus Then Space = "+" Else Space = "%20"

    For i = 1 To StringLen
      Char = Mid$(StringVal, i, 1)
      CharCode = Asc(Char)
      Select Case CharCode
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Char
        Case 32
          result(i) = Space
        Case 0 To 15
          result(i) = "%0" & Hex(CharCode)
        Case Else
          result(i) = "%" & Hex(CharCode)
      End Select
    Next i
    URLEncode = Join(result, "")
  End If
End Function

Answer 1

Geocoding API的文档实际上在这里有帮助：

  

因此您需要在此处添加密钥

Const API_KEY As String = "your key here"
http.Open "GET", "https://maps.googleapis.com/maps/api/geocode/xml?address=" & URLEncode(Address) & "&key=" & API_KEY, False