mail mail
Нужен макрос для Excel?
Сделайте заказ прямо сейчас!
Ищете готовое решение?
Выбирайте и покупайте!
У вас есть интернет-магазин?
Настроим парсер под любой сайт!

Получение кода региона (города) для работы с сервисами Яндекса

Иногда для программного формирования ссылки требуется получить код региона или города, зная его название.
(например, для поиска цен на товары в Яндекс.Маркете в заданном регионе)

К примеру, нужно найти некий товар в Москве, программно сформировав ссылку вида
httр://yandex.ru/yandsearch?text=НазваниеТовара&lr=213,
где 213 - это код города Москвы.

Функция GetYandexRegionCode позволяет быстро получить такой код, зная название города:

Sub ПримерПолученияКодаРегиона()
    КодРегиона1 = GetYandexRegionCode("Москва")    '  КодРегиона1 = 213
    КодРегиона2 = GetYandexRegionCode("Иркутская область")    '  КодРегиона2 = 11266
    КодРегиона3 = GetYandexRegionCode("Европа")    '  КодРегиона3 = 111
    КодРегиона4 = GetYandexRegionCode("Чукотский автономный округ")    '  КодРегиона4 = 10251
    КодРегиона5 = GetYandexRegionCode("Первоуральск")    '  КодРегиона5 = 11171
    
    Debug.Print КодРегиона1, КодРегиона2, КодРегиона3, КодРегиона4, КодРегиона5
End Sub

Функция выполняет запрос по ссылке search.yaca.yandex.ru/geo.c2n
и анализирует результаты ответа, в поисках подходящего региона.
В случае, если регион найден, возвращается его код, или 0, если найти заданный регион не удалось.
Регистр названия региона не учитывается.

Код функции GetYandexRegionCode:

Function GetYandexRegionCode(ByVal RegionName As String) As Long
    On Error Resume Next: Dim txt$
    Set oXMLHTTP = CreateObject("MSXML2.XMLHTTP")
    With oXMLHTTP
        .Open "GET", "http://search.yaca.yandex.ru/geo.c2n", False
        .send: sHTMLBody = .responseBody
    End With
    For i = 0 To UBound(sHTMLBody)
        txt$ = txt$ & ChrW(AscW(Chr(AscB(MidB(sHTMLBody, i + 1, 1)))))
    Next
    Set oXMLHTTP = Nothing
    arr = Split(txt$, vbLf)
    For i = LBound(arr) To UBound(arr)
        region = Split(arr(i), vbTab, 2)(1)
        If LCase(region) = LCase(RegionName) Then
            GetYandexRegionCode = Val(Split(arr(i), vbTab)(0)): Exit Function
        End If
    Next i
End Function

Комментарии

Настройки просмотра комментариев

Выберите нужный метод показа комментариев и нажмите "Сохранить установки".

Игорь, есть несколько вопросов:

1)
For i = 0 To UBound(sHTMLBody)
txt$ = txt$ & ChrW(AscW(Chr(AscB(MidB(sHTMLBody, i + 1, 1)))))
Next

если у нас в переменной sHTMLBody простой текст (т.е. строка каких-то символов), как мы можем обращаться к этой строке как к массиву и искать у него верхнюю границу через UBound(sHTMLBody) ?

Это тоже самое, что и UBound("какой-то странный код") - что тут выйдет? ОШИБКА!!!
Переменную sHTMLBody нужно сплитить (Split) через какой-то символ или искать в ней нужное через InStr(). Если сплитить, то результат сплита - будет массив и уже его обрабатывать через For Next, а не строку через Ubound()

P.S. Запусти код без On Error Resume Next.

2) и по-моему, нужно писать sHTMLBody = .responseText, а не sHTMLBody = .responseBody

Отправить комментарий

Содержание этого поля является приватным и не предназначено к показу.
CAPTCHA
Подтвердите, пожалуйста, что вы - человек:
  _____  ____     ___    _      ___        _ 
|__ / | _ \ / _ \ | |_ / _ \ | |
/ / | |_) | | | | | | __| | (_) | _ | |
/ /_ | _ < | |_| | | |_ \__, | | |_| |
/____| |_| \_\ \__\_\ \__| /_/ \___/
Введите код, изображенный в стиле ASCII-арт.

Не получается применить макрос? Не удаётся изменить код под свои нужды?

Оформите заказ у нас на сайте, не забыв прикрепить примеры файлов, и описать, что и как должно работать.