excel - para - obtener coordenadas de varias direcciones
Usar idiomas que no sean inglés para obtener las coordenadas de Google GeoCode (1)
Estoy usando esta PÁGINA para obtener las coordenadas del mapa de Google. Cuando se usan nombres en inglés, no hay problema y el archivo Excel devuelve las coordenadas. Pero al usar nombres persas (o en árabe) el archivo de Excel devuelve que la Request was empty or malformed . Configuré el idioma en el archivo VBA pero no solucioné el problema:
Request.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & Address & "&sensor=false" & "&language=fa", False
¿Que debería hacer?
Archivo: archivo de Excel
Una URL debe estar codificada en url. Entonces, dado que el otro es todo ASCII, la Address debe estar codificada en url. Pruebe el código después de Edit2 de la mejor respuesta de esta publicación. ¿Cómo puedo URL codificar una cadena en Excel VBA? como función URLEncode() para hacer esto. Esto debería ser compatible con todos los idiomas.
Request.Open "GET", "http://maps.googleapis.com/maps/api/geocode/xml?" _
& "&address=" & URLEncode(Address) & "&sensor=false" & "&language=fa", False
o dentro de la llamada de función
... GetCoordinates(URLEncode(Address))
Puse esas dos funciones en un Módulo:
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
Para que esas funciones funcionen, tuve que incluir una referencia a una versión reciente de las bibliotecas "Microsoft XML .." y "Microsoft ActiveX Data Objects" en el proyecto VBA.
