使用非英语语言获取谷歌GeoCode坐标

时间:2015-08-13 08:21:30

标签: excel google-maps excel-vba geolocation vba

我使用此PAGE获取Google地图坐标。使用英文名称时没有问题,excel文件返回坐标。但是当使用波斯语(或阿拉伯语)名称时,excel文件会返回Request was empty or malformed。我在VBA文件中设置了语言但是没有解决问题:

Request.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & Address & "&sensor=false" & "&language=fa", False

我该怎么办?

档案:Excel file

1 个答案:

答案 0 :(得分:2)

网址必须经过网址编码。因此,由于另一个都是ASCII,Address必须是url编码的。尝试使用此帖How can I URL encode a string in Excel VBA?的最佳答案的Edit2之后的代码作为函数URLEncode()来执行此操作。这应该支持所有语言。

Request.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & URLEncode(Address) & "&sensor=false" & "&language=fa", False

或在函数调用

... GetCoordinates(URLEncode(Address))

我将这两个功能放入模块中:

Function GetCoordinates(Address As String) As String

    '-----------------------------------------------------------------------------------------------------
    'This function returns the latitude and longitude of a given address using the Google Geocoding API.
    'The function uses the "simplest" form of Google Geocoding API (sending only the address parameter),
    'so, optional parameters such as bounds, key, language, region and components are NOT used.
    'In case of multiple results (for example two cities sharing the same name), the function
    'returns the FIRST OCCURRENCE, so be careful in the input address (tip: use the city name and the
    'postal code if they are available).

    'NOTE: As Google points out, the use of the Google Geocoding API is subject to a limit of 2500
    'requests per day, so be careful not to exceed this limit.
    'For more info check: https://developers.google.com/maps/documentation/geocoding

    'In order to use this function you must enable the XML, v3.0 library from VBA editor:
    'Go to Tools -> References -> check the Microsoft XML, v3.0.

    'Written by:    Christos Samaras
    'Date:          12/06/2014
    'e-mail:        xristos.samaras@gmail.com
    'site:          http://www.myengineeringworld.net
    '-----------------------------------------------------------------------------------------------------

    'Declaring the necessary variables. Using 30 at the first two variables because it
    'corresponds to the "Microsoft XML, v3.0" library in VBA (msxml3.dll).
    Dim Request         As New XMLHTTP30
    Dim Results         As New DOMDocument30
    Dim StatusNode      As IXMLDOMNode
    Dim LatitudeNode    As IXMLDOMNode
    Dim LongitudeNode   As IXMLDOMNode

    On Error GoTo errorHandler

    'Create the request based on Google Geocoding API. Parameters (from Google page):
    '- Address: The address that you want to geocode.
    '- Sensor: Indicates whether your application used a sensor to determine the user's location.
    'This parameter is no longer required.
    Request.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?" _
    & "&address=" & Address & "&sensor=false", False

    'Send the request to the Google server.
    Request.send

    'Read the results from the request.
    Results.LoadXML Request.responseText

    'Get the status node value.
    Set StatusNode = Results.SelectSingleNode("//status")

    'Based on the status node result, proceed accordingly.
    Select Case UCase(StatusNode.Text)

        Case "OK"   'The API request was successful. At least one geocode was returned.

            'Get the latitdue and longitude node values of the first geocode.
            Set LatitudeNode = Results.SelectSingleNode("//result/geometry/location/lat")
            Set LongitudeNode = Results.SelectSingleNode("//result/geometry/location/lng")

            'Return the coordinates as string (latitude, longitude).
            GetCoordinates = LatitudeNode.Text & ", " & LongitudeNode.Text

        Case "ZERO_RESULTS"   'The geocode was successful but returned no results.
            GetCoordinates = "The address probably not exists"

        Case "OVER_QUERY_LIMIT" 'The requestor has exceeded the limit of 2500 request/day.
            GetCoordinates = "Requestor has exceeded the server limit"

        Case "REQUEST_DENIED"   'The API did not complete the request.
            GetCoordinates = "Server denied the request"

        Case "INVALID_REQUEST"  'The API request is empty or is malformed.
            GetCoordinates = "Request was empty or malformed"

        Case "UNKNOWN_ERROR"    'Indicates that the request could not be processed due to a server error.
            GetCoordinates = "Unknown error"

        Case Else   'Just in case...
            GetCoordinates = "Error"

    End Select

    'In case of error, release the objects.
errorHandler:
    Set StatusNode = Nothing
    Set LatitudeNode = Nothing
    Set LongitudeNode = Nothing
    Set Results = Nothing
    Set Request = Nothing

End Function


Public Function URLEncode( _
   StringVal As String, _
   Optional SpaceAsPlus As Boolean = False _
) As String
  Dim bytes() As Byte, b As Byte, i As Integer, space As String

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

  If Len(StringVal) > 0 Then
    With New ADODB.Stream
      .Mode = adModeReadWrite
      .Type = adTypeText
      .Charset = "UTF-8"
      .Open
      .WriteText StringVal
      .Position = 0
      .Type = adTypeBinary
      .Position = 3 ' skip BOM
      bytes = .Read
    End With

    ReDim result(UBound(bytes)) As String

    For i = UBound(bytes) To 0 Step -1
      b = bytes(i)
      Select Case b
        Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
          result(i) = Chr(b)
        Case 32
          result(i) = space
        Case 0 To 15
          result(i) = "%0" & Hex(b)
        Case Else
          result(i) = "%" & Hex(b)
      End Select
    Next i

    URLEncode = Join(result, "")
  End If
End Function

为了使这些功能起作用,我必须包含对最新版本的" Microsoft XML的引用。"以及" Microsoft ActiveX数据对象" VBA项目中的图书馆。

现在我有以下Excel表格: enter image description here