HERE Maps API:无法存储回复

时间:2017-06-15 05:32:05

标签: vba excel-vba maps response here-api

我正在使用HERE Maps geocodding API和VBA来验证我的地址并给出lat&多头的地址。我得到了回复,但无法存储和使用响应。

以下是我的代码:

Private Sub Execute_Click()

    Dim address, address1, address2, address3, state, city, zip As String
    Dim appId As String
    Dim appCode As String
    Dim hereServerName As String
    Dim strQuery As String
    Dim strLatitude As String
    Dim strLongitude As String
    Dim addressGeocode As String
    Dim hereResult As New MSXML2.DOMDocument
    Dim hereService As New MSXML2.XMLHTTP
    Dim rNodes As MSXML2.IXMLDOMNodeList
    Dim rNode As MSXML2.IXMLDOMNode

    hereServerName = "https://geocoder.cit.api.here.com/6.2/geocode.xml?"
    appId = "uL2kjU0xrylpwTQIgrl7"
    appCode = "2jhjonGD4MXzODki5T62Mg"

    Dim succ, actions As Integer
        succ = 0
        actions = 9
        For Row = 2 To actions
            On Error Resume Next
            address1 = Sheet1.Range("C" & Row)
            address2 = Sheet1.Range("D" & Row)
            address3 = Sheet1.Range("E" & Row)
            city = Sheet1.Range("F" & Row)
            state = Sheet1.Range("G" & Row)
            zip = Sheet1.Range("H" & Row)
            If address1 <> "" Then
                address = address1
            End If
            If address2 <> "" Then
                address = address & "," & address2
            End If
            If address3 <> "" Then
                address = address & "," & address3
            End If
            address = address & "," & city & "," & state & "," & zip
            address = URLEncode(address)
            strQuery = hereServerName & "searchtext=" & address & "&app_id=" & appId & "&app_code=" & appCode & "&gen=9"
            hereService.Open "GET", strQuery, False
            hereService.send
            hereService.waitForResponse
            'I get the repose for the request but i am unable to store it in the here Result[Xml response][1]
            MsgBox (hereService.responseText)
            hereResult.LoadXML (hereService.responseText) 'Result not being stored
            'I am unable to retrive any data from this statment.
            Set rNodes = hereResult.getElementsByTagName("DisplayPosition")
            For Each rNode In rNodes
                strLatitude = rNode.ChildNodes(0).ChildNodes(0).Text
                strLongitude = rNode.ChildNodes(0).ChildNodes(1).Text
                addressGeocode = strLatitude & "," & strLongitude
            Next rNode
            Sheet1.Range("I" & Row) = addressGeocode
        Next Row
    Exit Sub
End Sub

Public Function URLEncode(ByVal 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

请帮我解决这个问题。

1 个答案:

答案 0 :(得分:2)

我可以存储它。我只是将响应存储在临时变量strValue中,然后使用

enter image description here

strValue = (hereService.responseText)
hereResult.LoadXML (strValue)

由于您正在使用循环,请确保hereService.responseText实际上为循环的元素返回了一些内容。

另请避免使用OERN(On Error Resume Next)。这就像告诉代码&#34;闭嘴&#34;。以正确的方式处理错误。

修改

以下是经过全面测试的代码的一部分

strValue = (hereService.responseText)
hereResult.LoadXML (strValue)

strLatitude = hereResult.getElementsByTagName("Latitude").Item(0).Text
strLongitude = hereResult.getElementsByTagName("Longitude").Item(0).Text
addressGeocode = strLatitude & "," & strLongitude

Sheet1.Range("I" & Row) = addressGeocode

<强>截图

在必胜客位置测试(该死的我现在很饿:P

enter image description here