В сети интернет нашел скрипт который определяет координаты по адресу ( http://grindgis.com/software/microsoft-excel/geocoding-excel-and-google ) Единственная проблема в том, что необходимо адрес прописывать на латинице! Прошу помощи адаптировать данную функцию, так что бы адрес можно было прописывать на русском!
Код
Function MyGeocode(address As String) As String
Dim strAddress As String
Dim strQuery As String
Dim strLatitude As String
Dim strLongitude As String
strAddress = URLEncode(address)
'Assemble the query string
strQuery = "http://maps.googleapis.com/maps/api/geocode/xml?"
strQuery = strQuery & "address=" & strAddress
strQuery = strQuery & "&sensor=false"
'define XML and HTTP components
Dim googleResult As New MSXML2.DOMDocument
Dim googleService As New MSXML2.XMLHTTP
Dim oNodes As MSXML2.IXMLDOMNodeList
Dim oNode As MSXML2.IXMLDOMNode
'create HTTP request to query URL - make sure to have
'that last "False" there for synchronous operation
googleService.Open "GET", strQuery, False
googleService.send
googleResult.LoadXML (googleService.responseText)
Set oNodes = googleResult.getElementsByTagName("geometry")
If oNodes.Length = 1 Then
For Each oNode In oNodes
strLatitude = oNode.ChildNodes(0).ChildNodes(0).Text
strLongitude = oNode.ChildNodes(0).ChildNodes(1).Text
MyGeocode = strLatitude & "," & strLongitude
Next oNode
Else
MyGeocode = "Not Found (try again, you may have done too many too fast)"
End If
End Function
Public Function URLEncode(StringVal As String, Optional SpaceAsPlus As Boolean = False) As String
Dim StringLen As Long: StringLen = Len(StringVal)
If StringLen>0 Then
ReDim result(StringLen) As String
Dim i As Long, CharCode As Integer
Dim Char As String, Space As String
If SpaceAsPlus Then Space = "+" Else Space = "%20"
For i = 1 To StringLen
Char = Mid$(StringVal, i, 1)
CharCode = Asc(Char)
Select Case CharCode
Case 97 To 122, 65 To 90, 48 To 57, 45, 46, 95, 126
result(i) = Char
Case 32
result(i) = Space
Case 0 To 15
result(i) = "%0" & Hex(CharCode)
Case Else
result(i) = "%" & Hex(CharCode)
End Select
Next i
URLEncode = Join(result, "")
End If
End Function
Спасибо!
P.S. На форуме есть примеры с использованием Яндекса, и в тоже время интересует именно Гугл
Должен помочь код ниже, но как его применить пока не могу додуматься....
Код
function RusToURL(txt as string) as string
dim i as long, l as string, t as string
For i = 1 To Len(txt)
l = Mid$(txt, i, 1)
Select Case AscW(l)
Case Is > 256: t = "%" & Hex(AscW(l) \ 64 + 192) & "%" & Hex(8 * 16 + AscW(l) Mod 64)
Case 32: t = "+"
Case Else: t = l
End Select
RusToURL = RusToURL & t
Next
end function
P.S. Doober, яндекс и гугл дают приблизительные координаты по адресам которые не могут найти: СЕВАСТОПОЛЬ,ул. Чернореченская, 144 АРМЯНСК,ул. Симферопольская, 14 СЕВАСТОПОЛЬ,ул. Челюскинцев, 65 И эти координаты разные для каждого поисковика, а мое дело уже просмотреть и оставить более подходящее, это единственное зачем мне нужен гугль))))