Страницы: 1
RSS
HTTP запрос из VBA, Альтернативные спосбы
 
Добрый день,

Я написал небольшой файл Excel с макросами, который подтягивает с сайта приставов информацию по интересующему меня контрагенту. Для запросов я использовал конструкцию    
Код
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")

С некоторых пор (видимо из-за изменения ИТ политики) данный запрос перестал работать. Однако запрос к интернет-странице через Power Query работает. Записав рекордером получаю следующую конструкцию:
Код
    ActiveWorkbook.Queries.Add Name:="Table 0", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    Источник = Web.Page(Web.Contents(""https://ru.wikipedia.org/wiki/%D0%9F%D1%80%D0%BE%D0%B5%D0%BA%D1%82%D0%BD%D0%BE-%D1%81%D0%BC%D0%B5%D1%82%D0%BD%D0%B0%D1%8F_%D0%B4%D0%BE%D0%BA%D1%83%D0%BC%D0%B5%D0%BD%D1%82%D0%B0%D1%86%D0%B8%D1%8F""))," & Chr(13) & "" & Chr(10) & "    Data0 = Источник{0}[Data]," & Chr(13) & "" & Chr(10) & "    #""Измененный тип"" = Table.TransformColumnTypes(Data0,{{""Виды документации"", type te" & _
        "xt}, {""Процент от базовой цены"", Int64.Type}, {"""", Int64.Type}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    #""Измененный тип"""
    Sheets.Add After:=ActiveSheet
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 0"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Table 0]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = "Table_0"
        .Refresh BackgroundQuery:=False
    End With
Вопрос - есть ли альтернатива данному способу, чтобы загружать данные не на страничку экселя а напрямую в какой-нибудь обработчик Json?
 
Добрый день,

Да, речь идет о сайте ФССП, но вопрос не про то, как обрабатывать их данные. Вопрос в том, как эти данные получить с учетом ограничений ИТ-политики в компании
Изменено: vikttur - 30.07.2021 12:01:17
 
Можно вызывать "эталонную" программу Curl (входит в состав Win 10). Заносим (с помощью параметров командной строки) ответ во временный файл, читаем этот файл в кодировке UTF-8 и обрабатываем текст в формате JSON.
Владимир
 
попробуйте изменить это
Код
Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
на это
Код
Set oXMLHTTP = CreateObject("Msxml2.XMLHTTP.6.0")
 
Андрей_26,

Теперь вместо "не удается установить соединение" пишет "отказано в доступе" (
 
Vilebone, неужто сложно выложить код своего макроса здесь?
Чтобы помогающие исправили 1-2 строки, а не писали макрос с нуля?
Вы даже не сказали, по какой ссылке надо подгружать данные..
 
Игорь,

Код достаточно стандартный, не знаю, что там можно править:
Код
Private Function GetHTTPResponse(ByVal sURL As String) As String
    Dim oXMLHTTP
'    On Error Resume Next
    Set oXMLHTTP = CreateObject("MSXML2.ServerXMLHTTP.6.0")
    With oXMLHTTP
        .Open "GET", sURL, False
        .SetRequestHeader "Cache-Control", "max-age=0"
        .SetRequestHeader "Content-Type", "application/json"
        .SetRequestHeader "Accept", "application/json, text/javascript, */*"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/48.0.2564.41 Safari/537.36 OPR/35.0.2066.10 (Edition beta)"
        .SetRequestHeader "Accept-Encoding", "deflate"
        .SetRequestHeader "Accept-Language", "ru-RU,ru;q=0.8,en-US;q=0.6,en;q=0.4"
        .send
        GetHTTPResponse = .responseText
    End With
    Set oXMLHTTP = Nothing
End Function
Данные загружаются с URL
Код
https://api-ip.fssprus.ru/api/v1.0
 
Не получится эту ссылку прогрузить, без использования сторонних программ.
Средствами Windows эта страница не загрузится
(в том числе веб-запросом и браузером IE, в котором не поддерживаются необходимые для этого сайта протоколы шифрования)
Видимо, на сайте специально включили требование новых протоколов, чтобы работа с сервисом была возможна только из современных браузеров.
 
Цитата
Игорь написал:
api-error.png
Это при любом исполнении?
Токена у меня конечно нет, но обычный get запрос с данными от балды возвращает результат. Ничего не включал, win10 по умолчанию.
Скрытый текст
 
Игорь,

С домашнего компьютера ответ получается, проблема именно при использовании в корпоративной среде  
 
Ну так вы другую ссылку прогружаете
Что мешало сразу эту ссылку написать, - я бы проверил
 
Vilebone, в свойствах интернет эксплорера во вкладке Дополнительно посмотрите наличие галочек на TLS 1.0\1.1\1.2 и параметры HTTP 1.1\2.
А еще лучше бы скинули ошибку, которая вываливается при запросе в вашей компании. Может вам вообще доступ отрубили?)
 
Oleg Boyaroff,

Проверил, все галочки стоят. Из обычного браузера ссылка открывается. При открытии ссылки именно из IE всегда предлагает скачать .json файл
Ошибки ниже
 
Вот такая же фигня...
Как максимум, текст макроса, который я пишу, возвращает хтмл верстку запрашиваемой страницы, а никак не сам джсон.
Наверное я что-то не так делаю, но ощущение что именно сам сайт не дает доступа к данным по ссылке никак, кроме как через браузер.

Кукисы что ли надо прописать, я уже голову ломаю, чего туда еще в headers добавить, чтобы оно перестало измываться.
Страницы: 1
Наверх