Получение результата web-запроса на лист Excel

Пользователь

Сообщений: 239 Регистрация: 23.07.2013

27.08.2015 09:49:10

Добрый день, уважаемые форумчане

Интересует вопрос возможно ли в принципе из VBA
1. создать запрос к ресурсу http://www.uz.gov.ua/cargo_transportation/electronic_transportation/specifications_carriages_info/ (в поле номера вагонов вставить № вагона, например - 62111018)
2. эмулировать нажатие кнопки "получить информацию"
3. полученную информацию забрать на лист Excel

Почему спрашиваю возможно ли в принципе - потому что при использовании штатных средств Excel (Данные - Из интернета) вообще не увидел информации в нужных полях, я так понимаю есть "нюансы" некоторых сайтов при которых Excel их "не видит"?

Заранее спасибо

Игорь Пользователь Сообщений: 3695 Регистрация: 23.12.2012	#2 27.08.2015 12:48:08 Да, возможно. Только при помощи макросов (POST-запрос к сайту), а не штатными средствами (типа Данные - Из интернета) Надстройки для Excel Парсинг сайтов Мониторинг цен конкурентов

Vitallic Пользователь Сообщений: 239 Регистрация: 23.07.2013	#3 27.08.2015 13:30:38 Игорь, спасибо буду "копать"

Vitallic

Пользователь

Сообщений: 239 Регистрация: 23.07.2013

31.08.2015 14:09:17

Уважаемые форумчане,
прошу указать на ошибки макроса написаного для решения задачи указаной темы:

Код

Sub getinfo()
Dim XMLHTTP As MSXML2.XMLHTTP
ActiveSheet.[a1].ClearContents
Set XMLHTTP = New MSXML2.XMLHTTP
    XMLHTTP.Open "POST", "http://www.uz.gov.ua/cargo_transportation/electronic_transportation/specifications_carriages_info/", "false"
    XMLHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    XMLHTTP.SetRequestHeader "Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,image/webp,*/*;q=0.8"
    XMLHTTP.SetRequestHeader "Referer", "http://www.uz.gov.ua/car_info/index.php"
    XMLHTTP.SetRequestHeader "Accept-Language", "uk-UA,uk;q=0.8,ru;q=0.6,en-US;q=0.4,en;q=0.2"
    XMLHTTP.SetRequestHeader "Accept-Encoding", "gzip, deflate, lzma"
    XMLHTTP.SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/44.0.2403.155 Safari/537.36 OPR/31.0.1889.174"
    XMLHTTP.SetRequestHeader "Host", "www.uz.gov.ua"
    XMLHTTP.SetRequestHeader "Content-Length", "27"
    XMLHTTP.SetRequestHeader "Origin", "http://www.uz.gov.ua"
    XMLHTTP.SetRequestHeader "Upgrade-Insecure-Requests", "1"
    XMLHTTP.SetRequestHeader "DNT", "1"
    XMLHTTP.SetRequestHeader "Connection", "Keep-Alive"
    XMLHTTP.SetRequestHeader "Cache-Control", "max-age=0"
    XMLHTTP.Send ("p_NV=58930330")
    Do While XMLHTTP.readyState <> 4
    DoEvents
    Loop
    ActiveSheet.[a1] = XMLHTTP.ResponseText
    Set XMLHTTP = Nothing
End Sub

результат отработки макроса можна посмотреть в файле-примере
Подскажите, пожалуйста, что не так делаю - результатом работы даного макроса
должен быть ответ сервера на запрос с парамметром (№ вагона), а именно разрешение или запрет
выезда вагона за пределы страны (так и происходит если парамметр ввести на сайт через браузер),
но как добитсься того же эффекта при помощи VBA?
Прилагаю к данному сообщению заголовки запроса (рис.1)
рисунок удален: превышение допустимого размера вложения [МОДЕРАТОР]

Прикрепленные файлы

test 30 08 2015.xlsm (17.34 КБ)

Doober

Пользователь

Сообщений: 2383 Регистрация: 09.04.2013

31.08.2015 15:18:41

Вы просто не умеете готовить запросы

Так рулит?

Скрытый текст

Код

Sub getinfoNew()
 
    Dim XMLHTTP As MSXML2.XMLHTTP
    ActiveSheet.[a1].ClearContents
    Set XMLHTTP = New MSXML2.XMLHTTP
    XMLHTTP.Open "POST", "http://www.uz.gov.ua/car_info/index.php", "false"
    XMLHTTP.SetRequestHeader "Connection", "keep-alive"
    XMLHTTP.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    XMLHTTP.SetRequestHeader "Accept-Encoding", "gzip, deflate"
    XMLHTTP.Send ("p_NV=58930330")
    Do While XMLHTTP.readyState <> 4
        DoEvents
    Loop
    s = Replace(XMLHTTP.ResponseText, "&nbsp;", " ")
    Set XMLHTTP = Nothing
    Set RegExp = CreateObject("VBScript.RegExp")
    Pattern = ""
    For n = 1 To 17
        Pattern = Pattern & "<td[^>]*>(.+?)</td>"
    Next
    RegExp.Pattern = Pattern
    If RegExp.test(s) Then
        Set oMatches = RegExp.Execute(s)
        ReDim x(1 To 1, 1 To 17)
        For n = 1 To 17
            x(1, n) =Trim( oMatches(0).subMatches(n - 1))
        Next
        ActiveSheet.[a1].Resize(1, 17) = x
    End If
End Sub

Внес изменения

Изменено: Doober - 31.08.2015 15:25:06

Vitallic

Пользователь

Сообщений: 239 Регистрация: 23.07.2013

31.08.2015 16:45:18

Цитата
Doober написал: Вы просто не умеете готовить запросы

100% )
мало того что Вы сделали корректный запрос так еще и
распарсили регулярками!!!
Большое спасибо
Ушел учиться

Алексей Шебаниц Пользователь Сообщений: 8 Регистрация: 24.10.2017	#7 04.02.2020 13:43:00 Решил попробовать код у себя, Excel начал ругаться Прикрепленные файлы Безымянный.png (66.71 КБ)

Алексей Шебаниц Пользователь Сообщений: 8 Регистрация: 24.10.2017	#8 04.02.2020 14:16:24 установка библиотеки Microsoft XML 3.0 частично помогла, но теперь новое "но", дебагер указывает на строчку с XMLHTTP.Send ("p_NV=58930330") Прикрепленные файлы Безымянный.png (3.49 КБ) Изменено: Алексей Шебаниц - 04.02.2020 14:17:30

sokol92 Пользователь Сообщений: 4832 Регистрация: 10.09.2017	#9 04.02.2020 14:31:39 Переходите на объект WinHttpRequest. Используемый Вами код был написан в 2015 году. Изменено: sokol92 - 04.02.2020 14:32:48 Владимир

doober Пользователь Сообщений: 2383 Регистрация: 09.04.2013	#10 04.02.2020 14:52:29 Не в этом дело. надо http: заменить на https:

Алексей Шебаниц

Пользователь

Сообщений: 8 Регистрация: 24.10.2017

#11

06.02.2020 15:33:00

Цитата
doober написал: Не в этом дело.надо http: заменить на https:

Сработало)

Читают тему