Поиск координат на карте Google по адресу

[sasha_prof]

Ребята, помогите плиз с макросом поиска координат на карте по адресу.
Может у кого уже что есть?


Я вот нашел поиск по яндексу но он что-то не отрабатывает до конца

Option Explicit

Function getYandexMapsGeocode(sAddr As String) As String

' Tools - References - Microsoft XML, v3.0
Dim oXhr As XMLHTTP
Dim sQuery As String
Dim oXml As DOMDocument
Dim oLatLng As IXMLDOMNode

getYandexMapsGeocode = ""
Set oXhr = CreateObject("Microsoft.XMLHTTP")
sQuery = "http://geocode-maps.yandex.ru/1.x/?geocode="
sQuery = sQuery & Replace(sAddr, " ", "+")
sQuery = sQuery & "&results=1"
oXhr.Open "GET", sQuery, False
oXhr.send
Set oXml = oXhr.responseXML
Set oLatLng = oXml.getElementsByTagName("pos")(0)
getYandexMapsGeocode = oLatLng.Text

End Function

[EducatedFool]

попробуйте такой вариант
http://excelvba.ru/programmes/GoogleMapsCoordinates

[sasha_prof]

Пробовал.
Выдает по всем адресам ошибки.
А в код нет доступа к сожалению

У Вас отрабатывает нормально?

[IgorGO]

вместо этого

  sQuery = "http://geocode-maps.yandex.ru/1.x/?geocode="
  sQuery = sQuery & Replace(sAddr, " ", "+")
  sQuery = sQuery & "&results=1"

пробуйте такой

  sQuery = "http://geocode-maps.yandex.ru/1.x/?geocode=" & sAddr & "&results=1"

я координаты своего дома получил 30.365662 50.46292

[sasha_prof]

у меня на строке
oXhr.send

выходит из обработки кода.
Может чтото в тулс включить?

[Aleksandr H.]

Так надо яндекс или гугл?
на соседнем форуме есть рабочая функция для гугла

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

getGoogleMapsGeocode = ""

Set xhrRequest = New XMLHTTP60
sQuery = "http://maps.googleapis.com/maps/api/geocode/xml?sensor=false&language=ru&sector=ru&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

Dim d As Date
d = DateAdd("s", 1, Now)
Do While Now < d
DoEvents
Loop

End Function

[sasha_prof]

Впринципе всеравно.

но эта у меня тоже вылетает

на этом месте

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


Скажите плиз что не так?

[sasha_prof]

Можете показать что у вас подключено?

[IgorGO]

я исключил замену пробелов на плюсы и у меня пошел написанный в 1-м сообщении код

Киев, Доброхотова №Дома
и получил координаты
30.365662 50.46292

библиотека Microsoft XML, v3.0 - была подключена

[sasha_prof]

не работает

ixnStatus.Text= Invalid_request