2017-06-15 14 views
1

私はここでVBAを使用してジオコーディングAPIをマップして私のアドレスを検証し、そのアドレスの長さを&にします。私は応答を得るが、応答を格納して使用することができない。続きここではMaps API:レスポンスを保存できません

は私のコードです:

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 

私はこの問題を解決してください。

+0

「レスポンスを保存して使用することができません」 - これを少し拡張する必要があるかもしれません。それは、応答がどのように見えるかの例を含めるのに役立ちます。レスポンスがJSONの場合は、https://github.com/VBA-tools/VBA-JSONをご覧ください。 –

答えて

2

保存できます。私はちょうど一時変数strValueに応答を格納し、その後、あなたはループを使用しているので、hereService.responseTextが実際にループのその要素のために何かを返していることを確認してください

enter image description here

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

ことを使用しました。

また、OERN(On Error Resume Next)の使用は避けてください。それはコードを "シャット・アップ"するようなものです。適切な方法でエラーを処理します。ここで

編集

は完全にテストされたコードの一部である

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

関連する問題