從地址獲取GPS座標的代碼（VB6/VBA/VBScript）

Question

我相信Google API可以讓您獲得給定地址的座標。然而，我發現的大多數（或者應該說全部）例子都不適用於vb。通常這是一些JavaScript例子，只是讓我感到困惑。

這是我使用地理編碼服務的一些代碼。這很好。這只是我想直接查詢Google地圖。

Public Function fgGetLatAndLongUsingAddress(sAddress As String) As String 

    'This function works best with a complete address including the zip code 
    Dim sResponseText As String, sReturn As String 

    sReturn = "none" 

    Dim objHttp As Object, sQuery As String 
    sQuery = "http://rpc.geocoder.us/service/csv?address=" & Replace(sAddress, " ", "+") 
    Set objHttp = CreateObject("Msxml2.ServerXMLHTTP") 
    objHttp.Open "GET", sQuery, False 
    objHttp.send 
    sResponseText = objHttp.ResponseText 
    gsLastLatLongResponseText = sResponseText 
    Set objHttp = Nothing 


    If Len(sResponseText) > 0 Then 
     If InStr(sResponseText, "Bad Request") > 0 Then 
      'Do Nothing 
     ElseIf InStr(sResponseText, "couldn't find this address") > 0 Then 
      'Do Nothing 
     Else 
      If InStr(sResponseText, vbCrLf) > 0 Then 
       'We got more than one result 
      End If 
      If InStr(sResponseText, ",") > 0 Then 
       Dim aryInfo() As String 
       aryInfo = Split(sResponseText, ",") 
       sReturn = aryInfo(0) & "," & aryInfo(1) 
      End If 
     End If 
    End If 


    fgGetLatAndLongUsingAddress = sReturn 

End Function 

Answer 1

這應該做的工作。你需要通過工具添加一個引用到MSXML6庫（微軟XML，V6.0）>在Excel中引用

Option Explicit 

Function getGoogleMapsGeocode(sAddr As String) As String 

Dim xhrRequest As XMLHTTP60 
Dim sQuery As String 
Dim domResponse As DOMDocument60 
Dim ixnStatus As IXMLDOMNode 
Dim ixnLat As IXMLDOMNode 
Dim ixnLng As IXMLDOMNode 


' Use the empty string to indicate failure 
getGoogleMapsGeocode = "" 

Set xhrRequest = New XMLHTTP60 
sQuery = "http://maps.googleapis.com/maps/api/geocode/xml?sensor=false&address=" 
sQuery = sQuery & Replace(sAddr, " ", "+") 
xhrRequest.Open "GET", sQuery, False 
xhrRequest.send 

Set domResponse = New DOMDocument60 
domResponse.loadXML xhrRequest.responseText 
Set ixnStatus = domResponse.selectSingleNode("//status") 

If (ixnStatus.Text <> "OK") Then 
    Exit Function 
End If 

Set ixnLat = domResponse.selectSingleNode("/GeocodeResponse/result/geometry/location/lat") 
Set ixnLng = domResponse.selectSingleNode("/GeocodeResponse/result/geometry/location/lng") 

getGoogleMapsGeocode = ixnLat.Text & ", " & ixnLng.Text 

End Function 

只有你實際例子的差異是：

• 更改URL和所述查詢的參數使用谷歌API
• 治療的響應爲XML文檔，並使用XPath提取所需結果

顯然第在我的代碼中沒有任何錯誤處理，但它應該讓你知道你需要使用API​​。你一定要自己諮詢API documentation瞭解速率限制等

Answer 2

感謝您的代碼！它效果很好。感謝您提高費率限制。以下是Google的說法：

使用Google地理編碼API時，每天的查詢限制爲2500個地理位置請求。 （Google Maps API Premier的用戶每天最多可以執行100,000次請求。）此限制的執行用於防止濫用和/或重新調整地理編碼API，並且此限制可能會在未來的情況下進行更改，恕不另行通知。此外，我們強制執行請求率限制以防止濫用服務。如果您超過24小時限制或以其他方式濫用該服務，地理編碼API可能暫時停止爲您工作。如果您繼續超過此限制，則可能會阻止您訪問地理編碼API。 注意：地理編碼API只能與Google地圖一起使用;禁止在地圖上顯示地理編碼結果。有關允許使用的完整詳細信息，請參閱Maps API服務條款許可限制。