Search code examples
google-mapsexcelgeolocationvba

Using non-english languages to get google GeoCode coordinates


I'm using this PAGE to get Google map coordinates. When using English names there is no problem and excel file returns coordinates. But when using Persian (or Arabic) names excel file returns Request was empty or malformed.I set language in VBA file but din't fix the problem:

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

What should I do?

File: Excel file


Solution

  • A URL must be url encoded. So since the other is all ASCII, the Address must be url encoded. Try the code after Edit2 from the best answer of this post How can I URL encode a string in Excel VBA? as function URLEncode() to do this. This should support all languages.

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

    or within the function call

    ... GetCoordinates(URLEncode(Address))
    

    I put those two functions into a Module:

    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:        [email protected]
        '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
    

    To get those functions to work, I had to include a reference to a recent version of the "Microsoft XML.." and the "Microsoft ActiveX Data Objects" libraries in the VBA project.

    Now I have the following Excel sheet: enter image description here