2017-11-26 7 views
-1

住所が豊富なExcelシートと一致する座標があります。私はGoogle Places APIを使用して私を得る関数を作成したいと思います。 g。特定の住所を取り囲むすべてのレストラン。私はすべての一致するレストランの名前を出力しようとすると、問題は、出力はちょうど "0"です。Google Places API(近くの検索)データをExcel VBAに取得するには

ここに私のコードです:

Function Nearby(Lat As Long, Lng As Long) As Variant 

    'Variablen definieren 
    Dim Request     As New XMLHTTP30 
    Dim Results     As New DOMDocument30 
    Dim StatusNode    As IXMLDOMNode 
    Dim NearbyNode    As IXMLDOMNode 

    On Error GoTo errorHandler 
    Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=" & Lat & "," & Lng & "&radius=50&type=restaurant&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU""" 
    Request.send 
    Results.LoadXML Request.responseText 

    Set StatusNode = Results.SelectSingleNode("//status") 
    Select Case UCase(StatusNode.Text) 
     Case "OK" 

      Set NearbyNode = Results.SelectSingleNode("//result/name[1]/name[2]/name[3]/name[4]") 
      Nearby = NearbyNode.Text 
     Case "ZERO_RESULTS" 
      Nearby = "The address does not exists" 
     Case Else    
      Nearby = "Error" 
    End Select 

errorHandler: 
    Set StatusNode = Nothing 
    Set NearbyNode = Nothing 
    Set Results = Nothing 
    Set Request = Nothing 

End Function 

答えて

0

私は少しあなたのコードを作り直し、例の下に試してみてください。

Option Explicit 

Sub TestNearby() 

    Dim NearbyNames 
    Dim NearbyState As String 

    Nearby "-33.8670522", "151.1957362", "1000", "hospital", NearbyNames, NearbyState 
    If NearbyState = "OK" Then 
     MsgBox Join(NearbyNames, vbCrLf) 
    Else 
     MsgBox NearbyState 
    End If 

End Sub 

Sub Nearby(Lat As String, Lng As String, Dist As String, PointType As String, Names As Variant, State As String) 

    Dim Request As Object 
    Dim Results As Object 
    Dim Node 

    On Error GoTo errorHandler 
    Set Request = CreateObject("MSXML2.XMLHTTP") 
    Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?" & _ 
     "location=" & Lat & "," & Lng & _ 
     "&radius=" & Dist & _ 
     "&type=" & PointType & _ 
     "&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU", False 
    Request.send 
    Set Results = Request.responseXML 
    Select Case UCase(Results.SelectSingleNode("//status").Text) 
     Case "OK" 
      With CreateObject("Scripting.Dictionary") 
       For Each Node In Results.SelectNodes("//PlaceSearchResponse/result/name") 
        .Add .Count, Node.nodeTypedValue 
       Next 
       Names = .Items() 
      End With 
      State = "OK" 
     Case "ZERO_RESULTS" 
      State = "No results" 
     Case Else 
      State = "Wrong request" 
    End Select 
    Exit Sub 

errorHandler: 
    State = "Error" 

End Sub 

私のための出力がされています

output

+0

はあなたに私をたくさん助けているので、多くの感謝します! – Juliama

+0

@Juliamaあなたが役に立ったと答えた場合は、こちらをクリックしてください。 – omegastripes

0

私はLat,Lngdoubleに変更して変更しました(ニーズより多くのエラーがトラップとはいえ)Request.Open "GET"文字列

Sub Nearby() 

Dim Request     As New XMLHTTP30 
Dim Results     As New DOMDocument30 
Dim StatusNode    As IXMLDOMNode 
Dim NearbyNode    As IXMLDOMNode 
Dim Node     As IXMLDOMNode 

    On Error GoTo errorHandler 

    Dim Lat As Double 'Chicago 
    Lat = 41.878114 
    Dim Lng As Double 
    Lng = -87.629798 

    Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=" & Lat & "," & Lng & "&radius=50&type=restaurant&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU" & "&sensor=False" 
    Request.send 
    Results.LoadXML Request.responseText 

    Set StatusNode = Results.SelectSingleNode("//status") 

    Select Case UCase(StatusNode.Text) 

     Case "OK" 
      For Each Node In Results.SelectNodes("//PlaceSearchResponse/result/name") 
       Debug.Print Node.nodeTypedValue 
      Next 

     Case "ZERO_RESULTS" 
      Debug.Print "The address does not exists" 

     Case Else 
      Debug.Print "Error" 

    End Select 

errorHandler: 
    Set StatusNode = Nothing 
    Set NearbyNode = Nothing 
    Set Results = Nothing 
    Set Request = Nothing 
End Sub 
+0

ありがとうございます!この情報を関数で取得する方法はありませんか?私はたくさんの住所を持っているので、私にはもっと簡単な機能があります。 – Juliama

0

この関数は、カンマ区切りの文字列を返します。

Public Function NearBy(Lat As Double, Lng As Double) As Variant 

Dim Request     As New XMLHTTP30 
Dim Results     As New DOMDocument30 
Dim StatusNode    As IXMLDOMNode 
Dim NearbyNode    As IXMLDOMNode 
Dim Node     As IXMLDOMNode 
Dim sz      As String 

    On Error GoTo errorHandler 

    Request.Open "GET", "https://maps.googleapis.com/maps/api/place/nearbysearch/xml?location=" & Lat & "," & Lng & "&radius=150&type=restaurant&key=AIzaSyA5nFPM_9Ss_X410c35WfoP_obP5UwppRU" & "&sensor=False" 
    Request.send 
    Results.LoadXML Request.responseText 

    Set StatusNode = Results.SelectSingleNode("//status") 

    Select Case UCase(StatusNode.Text) 

     Case "OK" 
      For Each Node In Results.SelectNodes("//PlaceSearchResponse/result/name") 
       sz = sz & Node.nodeTypedValue & ", " 
      Next 
      NearBy = Left(sz, Len(sz) - 2) 'remove last ", " 

     Case "ZERO_RESULTS" 
      NearBy = "The address does not exists" 

     Case Else 
      NearBy = "Error" 

    End Select 

errorHandler: 
    Set StatusNode = Nothing 
    Set NearbyNode = Nothing 
    Set Results = Nothing 
    Set Request = Nothing 

End Function 
関連する問題